Problème d'étiquette dans une procédure [Résolu]

[Runsh63]

Bonjour,

Je n'arrive pas à faire fonctionner ma macro comme je le veux. J'ai mis en place deux étiquettes qui doivent selon le choix de l'utilisateur déterminer quelle procédure lancer. Ci-dessous le code entré :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub MEF_RDIM()
 
' Permet de mettre en forme les relevés de dimension
 
Application.ScreenUpdating = False
 
    Dim Question1 As Integer
    MsgBox "Souhaitez-vous conserver les soldes d'ouverture et de fermeture de la période ?", vbYesNo + vbQuestion, "Paramétrage"
    If Question1 = vbYes Then
        GoTo Func1
    Else
        GoTo Func2
    End If
 
Func1:
 
'Ici la première procédure
 
Exit Sub
 
Func2:
 
'Ici la deuxième procédure
 
Application.ScreenUpdating = True
 
End Sub

Le problème est que que je clique sur "Oui" ou "Non", c'est toujours ma "Func2" qui se lance... Pouvez-vous m'expliquer ce que j'ai mal fait SVP ?

Je vous remercie d'avance et vous souhaite une bonne journée !

[gFZT82]

Bonjour,

Avec une petite modification du code

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub MEF_RDIM()
'Permet de mettre en forme les relevés de dimension
Application.ScreenUpdating = False
Dim Question1 As Integer
    Question1 = MsgBox("Souhaitez-vous conserver les soldes d'ouverture et de fermeture de la période ?", vbYesNo + vbQuestion, "Paramétrage")
    If Question1 = vbYes Then
        GoTo Func1
    Else
        GoTo Func2
    End If
Func1:
    MsgBox "YES"
    Exit Sub
Func2:
    MsgBox "NO"
End Sub

Cordialement.

[Runsh63]

Merci gFZT82, grosse erreur de débutant, j'enrage !!

[Ormonth]

Bonjour

sur le fond...

surtout pourquoi utiliser des étiquettes, ça correspond peu à la nature du VBA.

Si tu vises des fonctions, tu fais des procédures Function, sinon des procédures Sub

A part les traitements d'erreur et des cas extrêmes étiquettes ?


cordialement,

Didier

[Runsh63]

Bonjour Ormonth,

Tu as parfaitement raison, et c'était mon but premier que d'utiliser les fonctions. Voilà à quoi ressemblait mon code initialement :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub MEF_RDIM()
 
' Permet de mettre en forme les relevés de dimension
 
Application.ScreenUpdating = False
 
    'Nettoyer données précédentes et paramétrage de la fonction à utiliser
 
    With Sheets("Final data").UsedRange.ClearContents
    End With
 
    Dim Question1 As Integer
    Question1 = MsgBox("Souhaitez-vous conserver les soldes d'ouverture et de fermeture de la période ?", vbYesNo + vbQuestion, "Paramétrage")
    If Question1 = vbYes Then
        GoTo Function1
    Else
        GoTo Function2
    End If
 
End Sub
Sub Function1()
 
 'Procédure 1
 
Application.ScreenUpdating = True
 
End Sub
Sub Function2()
 
 'Procédure 2
 
Application.ScreenUpdating = True
 
End Sub

Problème lors du lancement de la macro, celle-ci s'arrête et le débogage me surligne "GoTo Function2" avec le message suivant "Compile error : Label not defined".
J'ai donc provisoirement laissé tombé (manque de temps) et suis passé par des étiquettes qui me semblaient pouvoir parer à ce souci. J'espère pouvoir un jour utiliser correctement les fonctions...

[Ormonth]

bonjour,

oui car ce n'est pas la bonne syntaxe

Pour appeler une fonction, il suffit d'évoquer son nom genre :

Code :

If VerifieExistence(txtAjoutParam.Value) = False Then

... pour la fonction VerifieExistence.

cordialement,

Didier

[Runsh63]

Bonjour Ormonth, bonjour à toutes et tous,


J'ai eu du mal à comprendre la syntaxe (et je n'ai pas encore tout compris...).
A force de fouiner sur la toile, voilà comment j'ai fait pour faire fonctionner ma macro :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub MEF_RDIM()
 
' Permet de mettre en forme les relevés de dimension
 
Application.ScreenUpdating = False
 
    'Nettoyer données précédentes et paramétrage de la fonction à utiliser
 
    With Sheets("Final data").UsedRange.ClearContents
    End With
 
    Dim Question1 As Integer
    Question1 = MsgBox("Souhaitez-vous conserver les soldes d'ouverture et de fermeture de la période ?", vbYesNo + vbQuestion, "Paramétrage")
    If Question1 = vbYes Then
        Call Function1
    Else
        Call Function2
    End If
 
End Sub

Ecrit ainsi, cela fonctionne, et c'est parfait. Le problème, c'est que je ne vois aucune différence technique dans l'exécution de la macro entre ces fonctions et les étiquettes, comme tu le soulignais dans ton post précédent :

Bonjour

sur le fond...

surtout pourquoi utiliser des étiquettes, ça correspond peu à la nature du VBA.

Si tu vises des fonctions, tu fais des procédures Function, sinon des procédures Sub

A part les traitements d'erreur et des cas extrêmes étiquettes ?

En quoi les fonctions sont-elles plus adaptées à VBA que les étiquettes ? Il faut savoir que mes macros ne sont que de simples mises en forme de données, du data-crunshing, rien de bien puissant.
En tout cas merci, je vais essayer d'approfondir cela.
Bonne journée !

[Ormonth]

Bonjour,

En quoi les fonctions sont-elles plus adaptées à VBA que les étiquettes ?

Oui, ça fonctionne, le souci est surtout au niveau lisibilité et maintenance du code, ça donne du code "spaghetti" comme dirait J. Walkenbach

Découper ton code en parties claires et indépendantes est un plus indéniable au niveau efficience.

Pour ce qui est de la syntaxe et du fond, vois ce tutoriel page 29 pour les procédures et fonctions, puis dans son ensemble tu ne le regretteras pas

ftp://ftp-developpez.com/bidou/Cours...rmationVBA.pdf

Pour terminer, si ce que tu appelles n'est pas destiné à retourner un résultat, mais à accomplir une série d'instructions, ne fais pas de Function mais des Sub simples... (là encore lisibilité etc...)

cordialement,

Didier

[Runsh63]

Re-bonjour Ormonth,

Tout d'abord, un grand merci pour le lien, ton aide et tes explications.
Ci-dessous le code développé, tu vas vite constater qu'il est "bidon", très simpliste et qu'il est forcément améliorable, surtout au vue de tes compétences. J'ai fait appel à des fonctions et une étiquette histoire de me familiariser avec elles, des fois que j'en ai besoin à l'avenir (je m'améliore petit à petit, à mon rythme, bien que je monte ces macros uniquement dans un souci de gain de temps de mise en forme de données).

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
Sub MEF_RDIM()
 
' Permet de mettre en forme les relevés de dimension
 
Application.ScreenUpdating = False
 
    'Nettoyer données précédentes et paramétrage de la fonction à utiliser
 
    With Sheets("Final data").UsedRange.ClearContents
    End With
 
    Dim Question1 As Integer
    Question1 = MsgBox("Souhaitez-vous conserver les soldes d'ouverture et de fermeture de la période ?", vbYesNo + vbQuestion, "Paramétrage")
    If Question1 = vbYes Then
        Call Function1
    Else
        Call Function2
    End If
 
End Sub
Sub Function1()
 
    'Copier coller données de l'onglet d'origine dans l'onglet de retraitement
 
    With Sheets("Original data")
    .Range("A1:" & .Range("A1").SpecialCells(xlCellTypeLastCell).Address).Copy Sheets("Final data").Range("A1")
    End With
 
    'Déterminer nombre de lignes, supprimer colonne des cumuls (col.H) et retraiter données
 
    Dim LR1 As Long, Curr As String
    With Sheets("Final Data")
 
DefineCurr:
    Curr = UCase(InputBox("Quelle est la devise locale de la société dont vous traitez les données ?", "Définition de la devise locale"))
    If Len(Curr) <> 3 Then
        MsgBox "La devise entrée doit comporter 3 caractères !", vbCritical, "Erreur !"
        GoTo DefineCurr
    Else
        If IsNumeric(Left(Curr, 1)) = True Or IsNumeric(Right(Left(Curr, 2), 1)) = True Or IsNumeric(Right(Curr, 1)) = True Then
            MsgBox "La devise entrée ne doit pas comporter de caractères numériques !", vbCritical, "Erreur !"
            GoTo DefineCurr
        End If
    End If
 
    LR1 = .Range("A65536").End(xlUp).Row
    .Range("H1").EntireColumn.Delete
 
        With .Range("H2:H" & LR1)
            .Formula = "=IF(RC[-7]=""CPT"", RC[-6], R[-1]C)"
            .Value = .Value
            .NumberFormat = "General"
        End With
 
        With .Range("I2:I" & LR1)
            .Formula = "=IF(AND(RC[-8]<>""CPT"", RC[-8]<>""Date""), RC[-8], """")"
            .Value = .Value
            .NumberFormat = "dd/mm/yyyy"
        End With
 
        With .Range("J2:J" & LR1)
            .Formula = "=IF(LEFT(RC[-8], 5)=""Solde"", """", IF(AND(RC[-9]<>""CPT"", RC[-9]<>""Date""), TRIM(RC[-8]), """"))"
            .Value = .Value
        End With
 
        With .Range("K2:K" & LR1)
            .Formula = "=IF(LEFT(RC[-9], 5)<>""Solde"", RC[-8], RC[-9])"
            .Value = .Value
        End With
 
        With .Range("L2:L" & LR1)
            .Formula = "=IF(LEFT(RC[-10], 5)<>""Solde"", RC[-8], RC[-10])"
            .Value = .Value
        End With
 
        With .Range("M2:M" & LR1)
            .Formula = "=IF(LEFT(RC[-11], 5)<>""Solde"", RC[-8], """ & Curr & """)"
            .Value = .Value
        End With
 
        With .Range("N2:N" & LR1)
            .Formula = "=IF(LEFT(RC[-12], 5)<>""Solde"", RC[-8], RC[-11])"
            .Value = .Value
            .NumberFormat = "#,##0.00"
        End With
 
        With .Range("O2:O" & LR1)
            .Formula = "=IF(LEFT(RC[-13], 5)<>""Solde"", RC[-8], RC[-12])"
            .Value = .Value
            .NumberFormat = "#,##0.00"
        End With
 
    'Supprimer colonnes initiales et lignes inutiles, renommer noms de champ
 
        .Range("A1:G1").EntireColumn.Delete
        .Range("A1:H1") = Array("Compte", "Date", "Activité", "N° Document", "Description", "Devise", "Mtt en dev transac", "Mtt en dev loc")
 
        .Range("B1:B" & LR1).AutoFilter Field:=1, Criteria1:="="
            If .Range("B1:B" & LR1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Range("B2:B" & LR1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End If
        .AutoFilterMode = False
 
    End With
 
    MsgBox "Traitement des données terminées", vbExclamation, "Fin de procédure"
 
Application.ScreenUpdating = True
 
End Sub
Sub Function2()
 
    'Copier coller données de l'onglet d'origine dans l'onglet de retraitement
 
    With Sheets("Original data")
    .Range("A1:" & .Range("A1").SpecialCells(xlCellTypeLastCell).Address).Copy Sheets("Final data").Range("B1")
    End With
 
    'Supprimer colonne des cumuls (col.H) et retraiter données
 
    Dim LR2 As Long
 
    With Sheets("Final Data")
    LR2 = .Range("B65536").End(xlUp).Row
    .Range("I1").EntireColumn.Delete
 
        With .Range("A2:A" & LR2)
            .Formula = "=IF(RC[1]=""CPT"", RC[2], R[-1]C)"
            .Value = .Value
            .NumberFormat = "General"
        End With
 
        With .Range("I2:I" & LR2)
            .Formula = "=TRIM(RC[-6])"
            .Value = .Value
        End With
 
    .Range("C2:C" & LR2).ClearContents
    .Range("I2:I" & LR2).Copy .Range("C2")
    .Range("I2:I" & LR2).ClearContents
 
    .Range("A1:H1") = Array("Compte", "Date", "Activité", "N° Document", "Description", "Devise", "Mtt en dev transac", "Mtt en dev loc")
    .Range("F1:F" & LR2).AutoFilter Field:=1, Criteria1:="Devise", Criteria2:="=", Operator:=xlOr
        If .Range("F1:F" & LR2).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range("F2:F" & LR2).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End If
    .AutoFilterMode = False
 
    End With
 
    MsgBox "Traitement des données terminées", vbExclamation, "Fin de procédure"
 
Application.ScreenUpdating = True
 
End Sub

Encore merci pour tout, bon après-midi avant le WE !