Macro avec condition

B

badoum66

XLDnaute Nouveau
Bonjour,

J'ai une macro qui exécute 2 TCD.

Est-il possible d'insérer une boite de dialogue entre les 2 tableaux. Exemple " voulez vous executer le deuxieme tableau" Oui la macro execute le 2ème tableau. Non la macro se termine.

Merci pour vos réponse
 
Trier par date Trier par votes
cbea

cbea

XLDnaute Impliqué
Re : Macro avec condition

Bonjour badoum66,

Voici une solution.
Code: 
    Dim repMsg As Integer
    
    repMsg = MsgBox("Voulez-vous exécuter le deuxième tableau ?", vbYesNo, "TCD...")

    If repMsg = vbYes Then
        ' Actualiser le 2me TCD
    End If
 
Vote positif 0 Vote négatif
B

badoum66

XLDnaute Nouveau
Re : Macro avec condition

Merci pour ta réponse,

Si je fait non le deuxième TCD s'exécute.

Ci dessous copie de ma macro
J'ai inserer le bout de programme entre les 2 TDC.



Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 18/05/2008 par abdel
'

'
Cells.Select
Range("A1").Activate
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Range("A1").Select
Rows(1).EntireRow.Delete Shift:=xlUp
Range("Q1").Select
ActiveCell.CurrentRegion.Sort Key1:=Range("Q1"), Order1:=xlAscending, Header:=xlYes
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
While ActiveCell <> ""
If ActiveCell = donnee1 Then
ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
Else
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
End If
Wend
Sheets("Feuil1").Columns(28).Replace "A traiter par le Réceptionnaire", "REC"
Sheets("Feuil1").Columns(28).Replace "Réception non conforme", "RNC"
Sheets("Feuil1").Columns(28).Replace "Ne pas tenir compte de la règle en exception", "PAS"
Sheets("Feuil1").Columns(28).Replace "Demande d'avoir", "DMA"
Sheets("Feuil1").Columns(28).Replace "A traiter par l'Acheteur", "ACH"
Sheets("Feuil1").Columns(28).Replace "Modification saisie de commande: ajout avenant", "MCA"
Sheets("Feuil1").Columns(28).Replace "Modification saisie de la réception", "MDR"
Sheets("Feuil1").Columns(28).Replace "A traiter par le CCF", "CCF"
Sheets("Feuil1").Columns(28).Replace "Retour - demande d'avoir", "RDA"
Sheets("Feuil1").Columns(28).Replace "Attente livraison complémentaire", "ALC"
Sheets("Feuil1").Columns(28).Replace "Modification saisie de la commande: prix unitaire", "MCP"
Range("BD1").Select
ActiveCell.FormulaR1C1 = "Échéance"
With ActiveCell.Characters(Start:=1, Length:=8).Font
.Name = "Arial Unicode MS"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

[BD2].FormulaR1C1 = "=IF(R[-0]C[-36]<TODAY(),""Echue"",""Non echue"")"
Range("BD2").AutoFill Destination:=Range("BD2:BD" & [A65000].End(xlUp).Row)

Range("Feuil1!A1:BD" & [A65000].End(xlUp).Row).Name = "plage"
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="plage").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique2", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"Motif Except.").Subtotals = Array(False, False, False, False, False, False, False, _
False, False, False, False, False)
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Échéance"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("Tableau croisé dynamique2").AddFields RowFields:= _
Array("Échéance", "Données"), ColumnFields:="Motif Except."
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"N° Pièce")
.Orientation = xlDataField
.Position = 1
End With
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"Montant Total HT Facture").Orientation = xlDataField
ActiveWorkbook.ShowPivotTableFieldList = True

Dim repMsg As Integer

repMsg = MsgBox("Y a t'il un impact CLI ?", vbYesNo, "TCD...")

If repMsg = vbYes Then
' Actualiser le 2me TCD
End If

Sheets("Feuil1").Select
Range("Feuil1!A1:BD" & [A65000].End(xlUp).Row).Name = "plage"
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="plage").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"Motif Except.").Subtotals = Array(False, False, False, False, False, False, False, _
False, False, False, False, False)
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("BU DEST"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Échéance"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("Tableau croisé dynamique1").AddFields RowFields:= _
Array("BU DEST", "Échéance", "Données"), ColumnFields:="Motif Except."
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"N° Pièce")
.Orientation = xlDataField
.Position = 1
End With
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"Montant Total HT Facture").Orientation = xlDataField
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("BU DEST" _
)
.PivotItems("02177").Visible = True
.PivotItems("").Visible = False
End With
Range("A12").Select


End Sub
 
Vote positif 0 Vote négatif
M

Moulinois

XLDnaute Occasionnel
Re : Macro avec condition

Bonjour,

Code: 
If repMsg = vbYes Then
' Actualiser le 2me TCD
End If
Signifie que tu dois mettre la partie de ton code qui porte sur le secon TCD à la place de " ' Actualiser le 2me TCD"
(Cette seconde partie ne s'éxécutera donc que si l'on répond oui)


@+
 
Vote positif 0 Vote négatif
cbea

cbea

XLDnaute Impliqué
Re : Macro avec condition

re,

A tester :
Code: 
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 18/05/2008 par abdel
'

'
    Dim repMsg As Integer
    
    Cells.Select
    Range("A1").Activate
    Selection.Copy
    Sheets.Add
    ActiveSheet.Paste
    Range("A1").Select
    Rows(1).EntireRow.Delete Shift:=xlUp
    Range("Q1").Select
    ActiveCell.CurrentRegion.Sort Key1:=Range("Q1"), Order1:=xlAscending, Header:=xlYes
    donnee1 = ActiveCell
    ActiveCell.Offset(1, 0).Select
    
    While ActiveCell <> ""
        If ActiveCell = donnee1 Then
            ActiveCell.EntireRow.Delete
            ActiveCell.Offset(-1, 0).Select
            donnee1 = ActiveCell
            ActiveCell.Offset(1, 0).Select
        Else
            donnee1 = ActiveCell
            ActiveCell.Offset(1, 0).Select
        End If
    Wend
    Sheets("Feuil1").Columns(28).Replace "A traiter par le Réceptionnaire", "REC"
    Sheets("Feuil1").Columns(28).Replace "Réception non conforme", "RNC"
    Sheets("Feuil1").Columns(28).Replace "Ne pas tenir compte de la règle en exception", "PAS"
    Sheets("Feuil1").Columns(28).Replace "Demande d'avoir", "DMA"
    Sheets("Feuil1").Columns(28).Replace "A traiter par l'Acheteur", "ACH"
    Sheets("Feuil1").Columns(28).Replace "Modification saisie de commande: ajout avenant", "MCA"
    Sheets("Feuil1").Columns(28).Replace "Modification saisie de la réception", "MDR"
    Sheets("Feuil1").Columns(28).Replace "A traiter par le CCF", "CCF"
    Sheets("Feuil1").Columns(28).Replace "Retour - demande d'avoir", "RDA"
    Sheets("Feuil1").Columns(28).Replace "Attente livraison complémentaire", "ALC"
    Sheets("Feuil1").Columns(28).Replace "Modification saisie de la commande: prix unitaire", "MCP"
    Range("BD1").Select
    ActiveCell.FormulaR1C1 = "Échéance"
    
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial Unicode MS"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    [BD2].FormulaR1C1 = "=IF(R[-0]C[-36]<TODAY(),""Echue"",""Non echue"")"
    Range("BD2").AutoFill Destination:=Range("BD2:BD" & [A65000].End(xlUp).Row)
    
    Range("Feuil1!A1:BD" & [A65000].End(xlUp).Row).Name = "plage"
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="plage").CreatePivotTable TableDestination:="", TableName:= _
        "Tableau croisé dynamique2", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
        "Motif Except.").Subtotals = Array(False, False, False, False, False, False, False, _
        False, False, False, False, False)
    ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Échéance"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("Tableau croisé dynamique2").AddFields RowFields:= _
        Array("Échéance", "Données"), ColumnFields:="Motif Except."
    
    With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("N° Pièce")
        .Orientation = xlDataField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
        "Montant Total HT Facture").Orientation = xlDataField
    ActiveWorkbook.ShowPivotTableFieldList = True
    
    
    repMsg = MsgBox("Y a t'il un impact CLI ?", vbYesNo, "TCD...")
    
    If repMsg = vbYes Then
        Sheets("Feuil1").Select
        Range("Feuil1!A1:BD" & [A65000].End(xlUp).Row).Name = "plage"
        ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="plage").CreatePivotTable TableDestination:="", TableName:= _
            "Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
        ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
        ActiveSheet.Cells(3, 1).Select
        ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
            "Motif Except.").Subtotals = Array(False, False, False, False, False, False, False, _
            False, False, False, False, False)
        ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("BU DEST"). _
            Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
            False, False)
        ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Échéance"). _
            Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
            False, False)
        ActiveSheet.PivotTables("Tableau croisé dynamique1").AddFields RowFields:= _
            Array("BU DEST", "Échéance", "Données"), ColumnFields:="Motif Except."
        
        With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("N° Pièce")
            .Orientation = xlDataField
            .Position = 1
        End With
        ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
            "Montant Total HT Facture").Orientation = xlDataField
        With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("BU DEST")
            .PivotItems("02177").Visible = True
            .PivotItems("").Visible = False
        End With
    End If
    
    Range("A12").Select
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Résolu(e)
Microsoft 365 Archivage automatique sous condition (Macro)
Réponses
2
Affichages
356
HugoLaChips
H
L
  • Question
Microsoft 365 Macro choisir onglet à exporter dans un nouveau classeur
Réponses
5
Affichages
429
l.et.lilou
L
3
  • Question
XL 2013 copier et coller un tableau croisé dynamique
Réponses
3
Affichages
203
306255
3
M
  • Question
Autres Formule avec conditions
2
Réponses
25
Affichages
595
Moreno076
M
D
  • Résolu(e)
Microsoft 365 Comment executer la deuxième partie de la macro après verification
Réponses
6
Affichages
474
mapomme
mapomme
F
  • Question
XL 2016 concatenation caracteres colonne tableau
Réponses
9
Affichages
310
finarobert
F
C
  • Question
XL 2013 comment copier une mise en forme automatiquement avec une formule ?
Réponses
6
Affichages
545
fanch55
fanch55
P
  • Résolu(e)
Microsoft 365 Macro qui permet de basculer entre oui et non
Réponses
4
Affichages
253
pat66
P
A
  • Question
XL 2019 Modification d'une VBA ou Macro pour une recherche d'occurrence via les lois binomial ou calcul factoriel
2
Réponses
15
Affichages
522
Aeroberto0099bis
A
R
  • Résolu(e)
XL 2019 Recherche valeur (Critère date et ID) et copier valeur dans tableau dans la cellule correspondante
3 4 5
Réponses
66
Affichages
2 K
Rabeto
R

Membres actuellement en ligne

5 membres et 43 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 677
Messages
2 090 825
Membres
104 677
dernier inscrit
soufiane12