Macro acceptation d'écrasement des données par TCD

Version imprimable

19/04/2021, 17h20
romanza

Macro acceptation d'écrasement des données par TCD

Bonjour,

Je joins un classeur de gestion de projet. C'est dans le dernier onglet "Mail actualisation" que se situe mon interrogation et mon problème : https://mon-partage.fr/f/8kOdZEQJ/

Cette feuille est destinée à être envoyée par mail via macro intégrée. Il y a un tableau croisé dynamique avec des segments pour le filtrage (ici des prénoms). Sous le TCD, un message finalisant le mail avec une signature.

Quand je défiltre le TCD via le segment , j'ai le message attendu "Voulez-vous remplacer le contenu des cellules existantes?" avec le choix "OK" ou "Annuler". Normal car il existe des données sous ce TCD. Si on clique sur "OK", une autre macro ('Adapte le texte sous le TCD à la hauteur du TCD) permet de ne pas écraser le contenu situé initialement sous le TCD.

Or, sachant que le classeur et la feuille Excel correspondants sont destinés à d'autres utilisateurs , je souhaiterais qu'une macro valide automatiquement "OK" et donc que ce message n'apparaisse pas.

Je pensais qu'en intégrant dans la macro ci-dessus l'expression : Application.DisplayAlerts = False, ce message disparaitrait mais...non.

Par contre en gardant cette expression, en défiltrant le TCD via les boutons de filtre situés sur le TCD, je n'ai plus aucun message, cela fonctionne.

Du coup, la solution doit peut être résider dans une instruction du même genre mais qui concernerait également un filtrage via segment.

Merci beaucoup pour votre aide

Romanza

Citation:

Envoyé par romanza

Bonjour,

Il faut simplement masquer ou faire apparaître les lignes entre le TCD et la cellule "Date de retour souhaitée...". Dans le code ci-dessous, cette cellule correspond à la zone nommée "ZoneDateDeRetour". Pour que cela fonctionne correctement, il vous faut 2 lignes a minima entre le bas du TCD non filtré et cette ligne.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
'Adapte le texte sous le TCD à la hauteur du TCD
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'
Dim LigneDateRetour As Long
Dim d&, t&
 
    LigneDateRetour = Range("ZoneDateDeRetour").Row
    Rows("1:" & LigneDateRetour).Hidden = False
    t = Target.TableRange2.Row + Target.TableRange2.Rows.Count - 1
    Rows(t + 1 & ":" & LigneDateRetour - 2).Hidden = True
   ' Selection.EntireRow.Hidden = True
 
    Debug.Print t
 
'Const p$ = "Bien cordialement"
'Const f$ = "=CONCATENATE(""Date de retour souhaitée le "")&TEXT(WORKDAY(Rétroplanning!C8,J2,'JoursFériés et mails'!B9:B17),""jj mmmm aaaa"")"
'  Application.DisplayAlerts = False
 
'    d = Cells(Rows.Count, "B").End(xlUp).Row
'    Do While d > t
'        Cells(d, "B").Clear
'        d = Cells(Rows.Count, "B").End(xlUp).Row
'    Loop
'    With Cells(t + 2, "B")
'        .Formula = f
'        .Font.Bold = True
'        .Font.Underline = True
'    End With
'    Cells(t + 4, "B").Value = p
'    With Shapes("Signature")
'      .Top = Cells(t + 7, "B").Top
'      .Left = Cells(t + 7, "B").Left
'
'
'    End With
 
End Sub

Bonjour Eric et merci beaucoup pour votre retour.
Voilà le code que j'ai donc recopié. j'ai laissé 3 lignes entre le bas du TCD défiltré et la cellule "Date de retour....". Cela bug sur la ligne "LigneDateRetour = Range("ZoneDateDeRetour").Row"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
'Adapte le texte sous le TCD à la hauteur du TCD
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'
Dim LigneDateRetour As Long
Dim d&, t&
 
    LigneDateRetour = Range("ZoneDateDeRetour").Row
    Rows("1:" & LigneDateRetour).Hidden = False
    t = Target.TableRange2.Row + Target.TableRange2.Rows.Count - 1
    Rows(t + 1 & ":" & LigneDateRetour - 2).Hidden = True
 
Selection.EntireRow.Hidden = True
 
    Debug.Print t
 
Const p$ = "Bien cordialement"
Const f$ = "=CONCATENATE(""Date de retour souhaitée le "")&TEXT(WORKDAY(Rétroplanning!C8,J2,'JoursFériés et mails'!B9:B17),""jj mmmm aaaa"")"
  Application.DisplayAlerts = False
    t = Target.TableRange2.Row + Target.TableRange2.Rows.Count - 1
    d = Cells(Rows.Count, "B").End(xlUp).Row
    Do While d > t
        Cells(d, "B").Clear
        d = Cells(Rows.Count, "B").End(xlUp).Row
    Loop
    With Cells(t + 2, "B")
        .Formula = f
        .Font.Bold = True
        .Font.Underline = True
    End With
    Cells(t + 4, "B").Value = p
    With Shapes("Signature")
      .Top = Cells(t + 7, "B").Top
      .Left = Cells(t + 7, "B").Left
 
 
    End With

21/04/2021, 11h19
Invité

Citation:

Envoyé par romanza

Il faut créer la zone nommée :
Pièce jointe 596227

Sinon, vous avez juste un copier coller ma macro sur la vôtre, vous n'avez pas supprimé le reste du code qui ne sert plus à rien.
21/04/2021, 12h05
romanza

Je vous transmets le fichier avec la macro corrigée : https://mon-partage.fr/f/IfZOR1uN/

J'ai bien affecté le nom ZoneDateDeRetour à la cellule. Au filtrage/défiltrage, il ne reste plus que la signature
21/04/2021, 12h10
Invité

Citation:

Envoyé par romanza

Quel est le problème ?
21/04/2021, 12h15
romanza

Quand je filtre un prénom sur le segment les expressions "Date de retour souhaitée le...." et "Bien cordialement" disparaissent
21/04/2021, 12h43
Invité

Citation:

Envoyé par romanza

Quand je filtre un prénom sur le segment les expressions "Date de retour souhaitée le...." et "Bien cordialement" disparaissent

Avec le fichier qui m'a servi à vous répondre, je n'ai pas de problème.
21/04/2021, 13h40
romanza

C'est OK Eric,

En fait, je n'avais pas neutralisé la partie de mon code initial qui ne sert plus.

Un GRAND MERCI, franchement.

Romanza