Macro, si case vide, afficher un message + stopper l'execution. Résolu

Question

Bonjour, 

Je travail sous microsoft Office 2007.

J'utilise la macro ci-dessous et j'aimerais qu'une personne me donne une phrase de code pour qu'elle fasse quelquechose en plus :).

La voici:
Sub ajouter_un_produit()
    Application.ScreenUpdating = False
    Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15").Copy
    Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(1, 0)
    Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
    Application.ScreenUpdating = False
    Sheets("ajout_produit_composant").Range("G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").Copy
    Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(0, 13)
    Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
    Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").ClearContents
    Application.CutCopyMode = False
End Sub

En gros, elle copie des cellules D et G de la feuille 2 et les colles sur la feuille 1. Ensuite cela supprime les case D et G. et Arrête le mode copier avec le Application.CutCopyMode=False.

Cette macro fonctionne parfaitement, celle-ci m'aide dans une sorte de questionnaire.


Dans ce questionnaire j'aimerais qu'aucune cellule  D et G ne soit vide avant d'être copier. J'aimerais donc ajouter une phrase qui permettrait de vérifier si les celllules D et G sont vides, et si l'une est vide pouvoir afficher le message: Veuillez répondre à toutes les questions. Et que cela stop la suite de la macro.

Si les cellules sont vides c'est bien évidement grâce à la phrase ClearContents. Afin que chaque utilisateur soit en face d'un questionnaire sans réponses.

J'espère avoir était claire.

Merci d'avance si une personne a la solution.

Alex

pijaku · Accepted Answer

Bonjour,
1- si toutes tes cellules sont contigües, tu peux utiliser la syntaxe : Range("A1:A10").
Dans ton exemple :
Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15")
s'écrit avantageusement :
Range("D3:D15")

2- pour ton test :
Il te faut réaliser une boucle sur ce Range.
Tu peux procéder comme ceci, ajoute ce code en début de ta macro :
Dim MaPlage As Range, Cel As Range

Set MaPlage = Sheets("ajout_produit_composant").Range("D3:D15")
For Each Cel In MaPlage 'pour toutes les cellules de la plage
    If Cel.Value = "" Then 'si elle est vide alors
        'message à l'utilisateur
        MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
        'sortie de la procédure
        Exit Sub
    End If
Next

Cordialement,
Franck P

Alexver · Answer

Merci pijaku de ta réponse c'est exactement cela. 

Pour la synthaxe, c'est vrai que la mienne était un peu barbard. Je l'ai donc modifié en conséquence, au vu des différents questionnaire que j'ai du crée elle ne sont pas toujours contigües. 

Pour avoir le même travail effectuer au niveau des cellules G j'ai ajouter a la suite une autre boucle. 
J'ai essayé de mettre Range("D3:D15;G3:G16) mais cela n'a pas fonctionné.

Merci pour tout partage de connaissance pijaku. Bonne journée :).


Macro final:

Sub ajouter_un_produit()

Dim MaPlage As Range, Cel As Range

Set MaPlage = Sheets("ajout_produit_composant").Range("D3:D15")
For Each Cel In MaPlage 'pour toutes les cellules de la plage
    If Cel.Value = "" Then 'si elle est vide alors
        'message à l'utilisateur
        MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
        'sortie de la procédure
        Exit Sub
    End If
Next

Set MaPlage = Sheets("ajout_produit_composant").Range("G3:G15")
For Each Cel In MaPlage 'pour toutes les cellules de la plage
    If Cel.Value = "" Then 'si elle est vide alors
        'message à l'utilisateur
        MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
        'sortie de la procédure
        Exit Sub
    End If
Next

    Application.ScreenUpdating = False
    Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15").Copy
    Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(1, 0)
    Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
    Application.ScreenUpdating = False
    Sheets("ajout_produit_composant").Range("G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").Copy
    Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(0, 13)
    Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
    Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").ClearContents
    Application.CutCopyMode = False
    
End Sub

foo · Answer

Bonjour

Voila ta macro modifier
A tester bien sur

Sub ajouter_un_produit()
Application.ScreenUpdating = False
   With Feuil2
   For L = 3 To 13
      If .Range("D" & L).Value = "" Then
         MsgBox "Veuillez répondre à toutes les questions"
         Exit Sub
      End If
   Next
   For L = 3 To 16
      If .Range("G" & L).Value = "" Then
         MsgBox "Veuillez répondre à toutes les questions"
         Exit Sub
      End If
   Next
      .Range("D3:D15").Copy
         DerLigne = Feuil1.Range("A" & Rows.Count).End(xlUp).Row + 1
         Feuil1.Range("A" & DerLigne).PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
      .Range("G3:G16").Copy
         DerLigne = Feuil1.Range("A" & Rows.Count).End(xlUp).Row + 1
         Feuil1.Range("A" & DerLigne).PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
      .Range("D3:D15").ClearContents
      .Range("G3:G16").ClearContents
    End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

A+

Maurice

Alexver · Answer

Merci Maurice, j'ai pas pu tester l'effet car même aprés avoir rempli mes questions, la message box reste et la macro ne s'execute pas.

Macro, si case vide, afficher un message + stopper l'execution.

4 réponses

Discussions similaires

Newsletters