Toujours Répondre Annuler à un pop-up Excel (mais pas avec DisplayAlert)

Le 07/10/2022 à 12:31

Bonjour,

Je cherche un code VBA qui me permettrait de toujours répondre "Annuler" à un pop-up Automatique de Excel (attention cela n'est pas un msgbox).

Je ne peux pas utiliser la fonction Display.Alert qui n'affiche plus le message, car je cherche à toujours Répondre "Annuler" au pop-up automatique de Excel (la fonction Display.Alert fait comme si je répondais "OK")

Et je ne sais pas comment faire

pop up automatique excel

Merci par avance pour vos retours

Le 07/10/2022 à 12:59

Bonjour,

Le popup est affiché suite à un code VBA ? Voir les quelques lignes de codes où l'erreur se produit serait un plus

Cordialement

Le 07/10/2022 à 13:42

Bonjour,

Non le pop up n'est pas généré par un VBA, c'est un message d'alerte venant d'Excel

Merci pour ton aide par avance

Le 07/10/2022 à 13:57

Non le pop up n'est pas généré par un VBA, c'est un message d'alerte venant d'Excel

Ok, mais quelle manipulation faites-vous pour avoir ce popup ?

Le 07/10/2022 à 14:14

Je sélectionne un dossier dans une liste déroulante (cf copie d'ecran le point 1)

Et cela actualise 3 TCD différents (cf copie d'ecran ci-dessous les points 2; 3; 4) en sélectionnant ce numéro de dossier dans chacun des TCD (pour visualiser les sortie de stock / achat facturé / achat en cours)

Le problème est que parfois je n'ai pas d'achat en cours pour un numéro de dossier (donc le TCD cherche un numéro qui n'existe pas et c'est pour cela que j'ai le message d'erreur qui provient de mon TCD) : dc je peux avoir dans le pire des cas 3 messages successifs qui me demande si je veux remplacer mon numéro de dossier par un autre numéro de dossier

Je dois répondre "Annuler" à chaque pop-up car sinon cela me fausse mes données car me ramène pas le bon dossier dans mon TCD

Est ce que j'ai réussi à ne pas te perdre ?

excel modop
Le 07/10/2022 à 14:19

Je sélectionne un dossier dans une liste déroulante (cf copie d'ecran le point 1)

Donc la sélection exécute un code VBA pour mettre les champs de page des TCD. Juste ?

Si oui, est-ce que vous pouvez poster le code en question

Le 07/10/2022 à 14:31

J'ai 2 feuilles excel :

Voici le code qui correspond à ma liste déroulante (copie d'ecran Point 1 ci-dessus ) (et ci-dessous les 3 TCD que j'actualise)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
With Sheets("ACHAT_CAF")
.[B2] = Target.Value

End With

If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
With Sheets("ACHAT_CAF")
.[F2] = Target.Value
End With

If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
With Sheets("ACHAT_CAF")
.[M2] = Target.Value
End With
End Sub

Le 07/10/2022 à 14:32

Voici le code qui permet de faire le lien avec la liste déroulante pour actualiser les TCD :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique1")
Set xPFile = xPTable.PivotFields("DealId")
'Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique2")
' Set xPFile = xPTable.PivotFields("Affaire")
' Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique3")
' Set xPFile = xPTable.PivotFields("N° Affaire")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True


If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
'Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique1")
'Set xPFile = xPTable.PivotFields("DealId")
Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique2")
Set xPFile = xPTable.PivotFields("Affaire")
'Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique3")
'Set xPFile = xPTable.PivotFields("N° Affaire")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True


If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
'Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique1")
'Set xPFile = xPTable.PivotFields("DealId")
'Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique2")
'Set xPFile = xPTable.PivotFields("Affaire")
Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique3")
Set xPFile = xPTable.PivotFields("N° Affaire")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Le 07/10/2022 à 14:38

Lorsque vous postez un code, merci d'utiliser les balises de codes en cliquant sur l'icone </> disponible dans le menu et en collant le code dans la fenêtre. Il sera plus facile à lire.

Essayez ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If not Intersect(Target, Range("B1")) Is Nothing Then
On Error Resume Next
With Sheets("ACHAT_CAF")
    .Range("B2") = Target.Value
    .Range("F2") = Target.Value
    .Range("M2") = Target.Value
End With
End If
end sub

NB : comme c'est un TCD et que vous faites varier le champ de page, vous pourriez utiliser le nom du TCD et l'instruction Currentpage aussi

Faites un test

Edit :
1. Attention, j'ai ajouté NOT dans le code

2.

Voici le code qui permet de faire le lien avec la liste déroulante pour actualiser les TCD :

Pour 3 fois les mêmes instructions ?

A la vue de votre deuxième code, vous ne pouvez pas avoir deux codes Worksheet_change dans la même feuille. Donc là, il y a erreur

Le 07/10/2022 à 16:29

Bonjour Dan,

Je viens de refaire le test avec votre code, j'ai encore le message d'erreur

Concernant le point 2, j'exécute 3 fois le même code car j'actualise mes 3 TCD avec le même code de dossier "CAFxxxx"

Concernant le worksheet_change , je remets le code que j'utilise en enlevant mes essais malheureux (actuellement cela semble fonctionner), qu'est ce que vous modifieriez ?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique1")
    Set xPFile = xPTable.PivotFields("DealId")

    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True

        If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False

    Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique2")
    Set xPFile = xPTable.PivotFields("Affaire")

    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True

    If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
      Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique3")
    Set xPFile = xPTable.PivotFields("N° Affaire")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub
Le 07/10/2022 à 18:11

Le code que vous donnez se trouve dans la feuille Fiche projet ?

Le 07/10/2022 à 18:23

Oui cela est dans le fichier Excel

Il y a 2 onglets :

1er Onglet : FICHE PROJET

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B1")) Is Nothing Then
On Error Resume Next
With Sheets("ACHAT_CAF")
    .Range("B2") = Target.Value
    .Range("F2") = Target.Value
    .Range("M2") = Target.Value
End With
End If
End Sub

2 eme Onglet : ACHAT_CAF

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique1")
    Set xPFile = xPTable.PivotFields("DealId")

    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True

        If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False

    Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique2")
    Set xPFile = xPTable.PivotFields("Affaire")

    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True

    If Intersect(Target, Range("FICHE PROJET'!B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
      Set xPTable = Worksheets("ACHAT_CAF").PivotTables("Tableau croisé dynamique3")
    Set xPFile = xPTable.PivotFields("N° Affaire")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub
Le 07/10/2022 à 18:41

Oui cela est dans le fichier Excel Il y a 2 onglets :

Alors plutôt que de mettre un code worksheet_change dans l'onglet ACHAT_CAF, je ferais ceci :

- supprimez le code Worksheet_change qui se trouve dans l'onglet ACHAT_CAF
- Insérez un module via le menu Insertion dans l'éditeur VBA
- Mettez votre code ci-dessous dans un module (je l'ai révisé)

Sub maj_TCD(Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String

On Error Resume Next

Application.ScreenUpdating = False

With Worksheets("ACHAT_CAF")
    Set xPTable = .PivotTables("Tableau croisé dynamique1")
    Set xPFile = xPTable.PivotFields("DealId")
    xStr = Target.Value
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr

    Set xPTable = .PivotTables("Tableau croisé dynamique2")
    Set xPFile = xPTable.PivotFields("Affaire")
    xStr = Target.Value
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr

    Set xPTable = .PivotTables("Tableau croisé dynamique3")
    Set xPFile = xPTable.PivotFields("N° Affaire")
    xStr = Target
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
End With
End Sub

- Ensuite dans le code Worksheet_change de votre premier onglet rajoutez ceci juste avant le END IF

maj_TCD Target

- Faites un test

Rem :
- pas besoin de remettre la ligne screenupdating à True. Cela se remet automatiquement à True en sortant du code
- vous pourriez vous éviter une variable xstr en mettant directement xPFile.CurrentPage = target.value

Le 07/10/2022 à 19:07

Bonjour Dan,

Malheureusement au niveau des TCD j'ai toujours le pop-up malgré la suppression des codes

Feuil 1 Fiche Projet

1

Feuil4 (ACHAT_CAF) est vide

2

Et dans le module 3 j'ai bien :

3
Le 07/10/2022 à 19:23

OK. On va voir cela autrement.

Probablement que les 3 TCD n'ont pas la même source de données

Je vais vous proposer autre chose

Le 07/10/2022 à 19:39

Bonjour,

je n'ai pas regardé dans le détail mais est-ce que cette option ne résoudrait pas le pb ou au moins une partie ?

image

eric

Le 07/10/2022 à 20:08

Malheureusement, non

Le 07/10/2022 à 20:10

Dans le code que je vous ai proposé ici https://forum.excel-pratique.com/s/goto/1096890
Question : Le nom de vos TCD est bien 1, 2 et 3 ?

Si B2, F2 et M2 font partie du TCD alors le code dans la feuille ACHAT doit être comme ceci

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B1")) Is Nothing Then
   ThisWorkbook.RefreshAll 'pour actualiser les TCD du fichier
   maj_TCD Target
End If
End Sub

Si ok,

Le 07/10/2022 à 20:47

Bonjour Dan,

Je viens de renommer les TCD dans le code du module 3 mais j'ai encore le pop-up d'alerte

4
Le 07/10/2022 à 22:49

En suivant les recommandations de Dan cela fonctionne

Merci encore

Rechercher des sujets similaires à "repondre annuler pop pas displayalert"