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

Signaler
Messages postés
44
Date d'inscription
lundi 1 juillet 2013
Statut
Membre
Dernière intervention
21 août 2013
-
Messages postés
44
Date d'inscription
lundi 1 juillet 2013
Statut
Membre
Dernière intervention
21 août 2013
-
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

4 réponses

Messages postés
12247
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
10 février 2021
2 574
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
4
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
44
Date d'inscription
lundi 1 juillet 2013
Statut
Membre
Dernière intervention
21 août 2013

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
Messages postés
12247
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
10 février 2021
2 574
regarde cette syntaxe :
Range("D3:D15,G3:G16")
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
Messages postés
44
Date d'inscription
lundi 1 juillet 2013
Statut
Membre
Dernière intervention
21 août 2013

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.