VBA - plusieur confitions If dans la macro « Private Sub Worksheet_Change »

[Hub]

Bonjour à tous,

Vous trouverez dans le fichier en pièce jointe, un extrait du projet final.

Le but est de contrôler la saisie des valeurs des cellules jaunes de la feuille 1 (dans le projet final, il y en à 22, ici il n’y en a que deux de tester). Elles ne peuvent être que des valeurs numériques et elles ne peuvent être ni « vide » ni égale à zéro.
En cas d’erreur, un MsgBox apparaît. Le message est soit en français soit en anglais.

Premier point)
J’ai glissé des MsgBox « étape blabla » pour vérifier comment évolue le programme et le stopper à chaque étape afin de trouver ou se situe l’erreur.
Elle se situe dans la feuille 1 car à priori, dans une « Private Sub Worksheet_Change(à chaque modification de cellule) », il n’est pas possible d’empiler des conditions If contrairement à une « Private Sub Worksheet_Calculate() » voir feuille 3.

Question :
Est il possible dans une macro « Private Sub Worksheet_Change » de faire appel à plusieurs conditions If ?
Si oui, comment ?
Si non, que proposez vous en sachant qu’il y a 22 cellules à tester ?

Deuxième point)
Je souhaiterai travailler avec des valeurs global ou autre de façon à ne pas devoir répéter 22 fois la macro TestNum_X.

Question)
Comment faut-il s’y prendre ?

D’avance merci pour vos réponses.

@+

 

[Modeste]

Re : VBA - plusieur confitions If dans la macro « Private Sub Worksheet_Change »

Bonjour Hub, le fil, le reste du forum,

Le problème, quand on débute est qu'on tire parfois des conclusions sur base d'essais concluants ... ou non.
Ta liste déroulante en Feuil1 est liée à C1. Malheureusement le changement de valeur dans cette cellule, lors de la sélection d'une langue dans ta liste n'est pas un événement qui peut être "intercepté".
Par contre, si tu avais utilisé une Validation des données dans une cellule quelconque pour proposer le choix de la langue, le Changement de valeur de cette cellule serait bien un événement, quant à lui.
Pour contourner la difficulté rencontrée, tu as utilisé l'événement Calculate ... le problème est que cet événement surviendra à de multiples reprises (et qu'à l'intérieur de cette procédure, tu en profites pour modifier le contenu des cellules de cette même feuille ... et même pour sélectionner cette feuille).

Dans son fichier Si... utilisait une macro associée à la liste déroulante ... tu aurais pu t'en inspirer ... on ne sait même pas si tu as jeté un coup d'œil?

La méthode empirique c'est bien, mais elle a ses limites. Assembler des bouts de code avec de la ficelle et de la boue pour colmater c'est un comme ça qu'a été créé Frankenstein (et chacun sait que la "créature" a fini par échapper à son créateur!)

Ça peut paraître décourageant, mais il vaut parfois mieux recommencer "proprement" (les parties problématiques ... je ne parle pas de la proposition de Robert)

[Edit:] pour illustrer ce que j'ai écrit (ce sera moins décourageant) un fichier à tester en pièce jointe: à chaque modif d'une des cellules jaunes, une boucle vérifie le contenu des 4 cellules et affiche le warning dans la langue sélectionnée. Le contenu de Feuil3 est supprimé (sauf les 2 messages) la procédure Calculate aussi et la Worksheet_Change de Feuil1 réduite à sa plus simple expression.
... Le tout me semble conforme à la demande initiale?

 

[Hub]

Re : VBA - plusieur confitions If dans la macro « Private Sub Worksheet_Change »

Bonjour le fil,

Toutes vos remarques et suggestions m'ont beaucoup aidé, non seulement j'obtiens ce que j'attendais mais en plus j'ai énormément appris !

Merci à tous.

@+

 

[jujunexcelpas]

Re : VBA - plusieur confitions If dans la macro « Private Sub Worksheet_Change »

Bonjour le forum bonjour tout le monde,
Je m'intègre à la discussion car j'ai un problème de macro! En effet j'ai un code qui me permet de:
vérifier si un classeur existe,
s'il existe il vérifie que le feuille que j'ajoute n'existe pas! si elle existe j'insers par le bas le contenu que je souhaite intégrer au classeur actif
Si la feuille n'existe pas il rajoute la feuille que je souhaite ajouter
Sinon
il crée le classeur et ajoute la feuille
je vous joins la belle traduction vba mais je plante sur la partie insertion de la feuille si celle ci existe

s = Feuil4.[A1]
    r = Feuil23.[c2]
    If Dir("C:\Users\" & s & "\dropbox\joueurs\" & r, vbDirectory) = "" Then _
    MkDir "C:\Users\" & s & "\dropbox\joueurs\" & r
' CREER UN CLASSEUR dans le dossier
    Application.ScreenUpdating = False
    xnomfic = Range("C2"): ficd = xnomfic & " Musculation.xlsx": xcell = Range("F2"): xnomsh = Replace(xcell, "/", "")
  ' CREER UN CLASSEUR
    Application.ScreenUpdating = False
    xnomfic = Range("C2"): ficd = xnomfic & " Musculation.xlsx": xcell = Range("F2"): xnomsh = Replace(xcell, "/", "")
    
  ' Contrôle de l'existence du fichier ou classeur
    If FichierExiste("C:\users\" & s & "\dropbox\joueurs\" & r & "\" & ficd) = "Vrai" Then ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        ' ------------------------------------------------------------------------------------------------------------------
        ' Le classeur existe - On recherche si la feuille existe
        
        [COLOR="#FF0000"]Workbooks.Open ("C:\users\" & s & "\dropbox\joueurs\" & r & "\" & ficd), UpdateLinks:=0: Workbooks(ficd).Activate  ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        Workbooks("Musculation.xlsm").Sheets("Modele").Range("A4:R34").Copy
                 With ActiveWorkbook.Sheets(xnomsh)
                .Rows("34:100").RowHeight = 13
                .Range("A4:R34").Rows(Sheets(xnomsh).Range("A" & Rows.Count).End(xlUp).Row + 1).Insert
            End With
            MsgBox "Sauvegarde " & r & " effectuée."
            ActiveWorkbook.Save
            ActiveWorkbook.Close
    Else[/COLOR]
       
        ' Le classeur existe - On ajoute la feuille
        Worksheets.Add After:=Sheets((Sheets.Count)): Worksheets(Sheets.Count).Name = xnomsh
        Workbooks("Musculation.xlsm").Sheets("Modele").Range("A:AG").Copy
            With ActiveWorkbook.Sheets(xnomsh)
                .Rows("4:34").RowHeight = 13
                .Range("A:AG").PasteSpecial Paste:=xlPasteValues
                .Range("A:AG").PasteSpecial Paste:=xlPasteFormats
                .Range("A:AG").PasteSpecial Paste:=xlPasteColumnWidths
                Workbooks("Musculation.xlsm").Sheets("Modele").Range("O4:R34").Copy
                 With ActiveWorkbook.Sheets(xnomsh)
                .Range("O4:R34").PasteSpecial Paste:=xlPasteFormulas
                .Range("A1").Select
            End With
            End With
        ActiveWindow.DisplayHeadings = False
        Application.DisplayFullScreen = True
        Application.CutCopyMode = False
        ActiveWindow.DisplayZeros = False
        ActiveWindow.DisplayGridlines = False
        MsgBox "Sauvegarde " & r & " effectuée."
         ActiveWorkbook.Save
         ActiveWorkbook.Close
         End If
        ' ------------------------------------------------------------------------------------------------------------------
        Else
        
        '___________________________________________________________________________________________________________________
        ' Création du fichier ou classeur et copie de la feuille modele
        Workbooks.Add
        Workbooks("Musculation.xlsm").Sheets("Modele").Range("A:AG").Copy
            With ActiveWorkbook.Sheets("Feuil1")
                .Rows("4:34").RowHeight = 13
                .Range("A:AG").PasteSpecial Paste:=xlPasteValues
                .Range("A:AG").PasteSpecial Paste:=xlPasteFormats
                .Range("A:AG").PasteSpecial Paste:=xlPasteColumnWidths
                Workbooks("Musculation.xlsm").Sheets("Modele").Range("O4:R25").Copy
                 With ActiveWorkbook.Sheets("Feuil1")
                .Range("O4:R25").PasteSpecial Paste:=xlPasteFormulas
                .Range("A1").Select
            End With
            End With
        ActiveWindow.DisplayHeadings = False
        Application.DisplayFullScreen = True
        Application.CutCopyMode = False
        ActiveWindow.DisplayZeros = False
        ActiveSheet.Name = xnomsh
        ActiveWorkbook.SaveAs Filename:="C:\users\" & s & "\dropbox\joueurs\" & r & "\" & xnomfic & " Musculation.xlsx"   ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
       
        ActiveWorkbook.Close
       MsgBox "Le Dossier " & r & " a bien été créé."
   'End If
    End If
    'ActiveWindow.SelectedSheets.PrintOut from:=1, To:=1, copies:=1, collate:=0
    
        '___________________________________________________________________________________________________________________
    Application.ScreenUpdating = True
End Sub

Function FichierExiste(ficd) As Boolean
    FichierExiste = Dir(ficd) <> "" And ficd <> ""
End Function
Cordialement 
jujunexcelpas