Aide pour terminer un code qui ne fonctionne pas

**NEC14** · 05/02/2013, 13h49

Bonjour à tous,

J'ai une fichier contenant un certain nombre de feuilles commençant par la lettre "L".
Avec le code que j'ai essayé de faire, et lorsque je clique sur le bouton "Valider " de mon UserForm, je dois rechercher si la feuille existe dans mon fichier. Si elle n'existe pas on la créée, si elle existe alors on remplie les colonnes selon les données provenant de l'UserForm.
Mais cela ne marche pas, rien ne se produit. Je n'arrive pas à faire la recherche de la feuille dans mon fichier. La première partie fonctionne bien, mais pas la deuxième (TestA)
Pouvez-vous m'aider s'il vous plait à terminer mon code ?
Merci par avance

Premièrement on vérifie qu'aucune saisie n'a été oubliée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub CmbOk_Click()
Dim erreur(7) As Boolean, msg As String, I As Byte
Dim Tablo As Variant
 
'Ver = 0
Tablo = Array("", "La ligne de crédit ?", "Le tiers ?", "Le site ?", "L'objet ?", "Le n° d'engagement ?", "Le montant ?", "Qui engage ?")
erreur(1) = Me.CmbListCred = ""
erreur(2) = Me.CmbListeTiers = ""
erreur(3) = Me.CmbListeBat = ""
erreur(4) = Me.TxtObjet = ""
erreur(5) = Me.TxtNum = ""
erreur(6) = Me.TxtMontant = ""
erreur(7) = Me.CmbNom = ""
For I = 1 To 7
    If erreur(I) Then msg = msg & vbCrLf & "-" & " " & Tablo(I)
Next
If msg <> "" Then
    MsgBox "Vous avez oublié" & msg, 0, "A vérifier"
    Exit Sub
End If
 
TestA
UFEngt.CmbListCred.SetFocus
End Sub

Ensuite on passe à la recherche de la feuille et à son remplissage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Sub TestA()
Dim Ws As Worksheet, NumLig As String
Dim NewRech As Boolean, Exist As Boolean
Dim StFeuilComp As String
WbkRecap As Workbook
shtRecap As Worksheet
Dim LastLigF As Long, LastLigR As Long
 
Application.ScreenUpdating = False
 
Set Ws = ThisWorkbook.Sheets '(?)Toutes les feuilles commençant par L
 
NumLig = Me.CmbListCred.Value
NewRech = False
 
 
    For Each Ws In Worksheets
        If Ws.Name = "L" & NumLig Then 'on cherche la feuille selon CmbListCred
            Set shtRecap = Ws
            Exist = True
            Exit For
        End If
        Next Ws
        If Not Exist Then
        shtRecap = WbkRecap.Sheets.Add(Type:=xlWorksheet) 'si elle n'existe pas on l'a créée
        shtRecap.Name = "L" & NumLig
        NewRech = True
    End If
    'si elle existe on remplie le tableau avec les données de l'UserForm UFEngt
End If
       With Ws
       LastLigF = .Range("A65536").End(xlUp).Row + 1
       .Range("A" & LastLigF).Value = LastLigF - 7
       .Range("B" & LastLigF).Value = Me.TxtDate.Value
       .Range("B" & LastLigF).Value = Format(Me.TxtDate, "mm-dd-yyyy")
       .Range("C" & LastLigF).Value = Me.TxtNum
       .Range("D" & LastLigF).Value = Me.CmbListeBat.Value
       .Range("E" & LastLigF).Value = Me.TxtObjet.Value
       .Range("F" & LastLigF).Value = Me.TxtNumDev.Value
       .Range("G" & LastLigF).Value = Me.TxtDevis.Value
       .Range("G" & LastLigF).Value = Format(Me.TxtDevis, "mm-dd-yyyy")
       .Range("H" & LastLigF).Value = Me.CmbListeTiers.Value
       .Range("I" & LastLigF).Value = Me.LstTiers.Value
       .Range("J" & LastLigF).Value = Me.TxtMontant.Value
       .Range("K" & LastLigF).Value = Me.TxtMarche.Value
       .Range("L" & LastLigF).Value = Me.CmbNom.Value
       End With
    Ws.Close savechanges:=True
 
    Load UFEngt
    For I = 1 To 4 'On cherche les feuilles commençant par BC
        With Sheets("BC" & I)
            'On remplie les feuilles avec les données de l'UserForm UFEngt
            .Range("B24").Value = Me.CmbListeBat.Value
            .Range("B25").Value = Me.CmbNom.Value
            .Range("D24").Value = Me.CmbNom.Value
            .Range("G6").Value = CDate(Me.TxtDate)
            .Range("H14").Value = Me.CmbListCred.Value
            .Range("N11").Value = Me.CmbListeTiers.Value
            .Range("N15").Value = Me.TxtNum.Value
            .Range("N17").Value = Me.TxtMarche.Value
            .Range("N19").Value = Me.TxtNome.Value
            .Range("A29").Value = "Selon votre devis n°" & " " & Me.TxtNumDev & " " & "du" & " " & Me.TxtDevis & " " & "ci-joint."
            End With
 
        Next I
 
        End With
    End If
    Application.ScreenUpdating = True
End Sub

**Daniel.C** · 05/02/2013, 14h12

Bonjour,

Je ne comprends pas cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

shtRecap = WbkRecap.Sheets.Add(Type:=xlWorksheet)

Aparemment, "WbkRecap" n'est pas défini et je mettrais plutôt "Set shtRecap"

**QuestVba** · 05/02/2013, 14h17

Bonjour,

J'ai ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Feuil()
 
   Dim objWorksheet As Worksheet
   NumLig = 4
   IsWorksheet = False
   For Each objWorksheet In ActiveWorkbook.Worksheets
      If objWorksheet.Name = "L" & NumLig Then
         IsWorksheet = True
      End If
   Next
   If IsWorksheet = False Then
        Sheets.Add before:=Sheets(1)
        ActiveSheet.Name = "L" & NumLig
   End If
 
End Sub

**NEC14** · 05/02/2013, 14h34

Bonjour Daniel C.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

shtRecap = WbkRecap.Sheets.Add(Type:=xlWorksheet)

Je voulais indiquer que les feuilles sont du fichier actif

Bonjour QuestVba

Ton code concerne la partie où l'on vérifie si la feuille existe, est-ce bien cela ?

**Daniel.C** · 05/02/2013, 15h25

Alors remplace par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set WbkRecap = ActiveWorkbook
Set shtRecap = WbkRecap.Sheets.Add(Type:=xlWorksheet)

**QuestVba** · 05/02/2013, 15h39

Oui c'est effectivement la partie recherche de la feuille et création si elle n'existe pas

**NEC14** · 06/02/2013, 08h00

Bonjour à tous,

Voilà j'ai mis en place ce code, mais ça ne fonctionne toujours pas. Rien ne se passe. C'est vraiment une prise de tête.
Où ça coince, je ne comprends plus et je ne sais plus où j'en suis.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub TestA()
Dim Ws As Worksheet, NumLig As String
Dim NewRech As Boolean, Exist As Boolean
Dim StFeuilComp As String
WbkRecap As Workbook
ShtRecap As Worksheet
Dim LastLigF As Long, LastLigR As Long
 
Application.ScreenUpdating = False
 
Dim objWorksheet As Worksheet
   NumLig = 4
   IsWorksheet = False
   For Each objWorksheet In ActiveWorkbook.Worksheets
      If objWorksheet.Name = "L" & NumLig Then
         IsWorksheet = True
      End If
   Next
   If IsWorksheet = False Then
        Sheets.Add before:=Sheets(1)
        ActiveSheet.Name = "L" & NumLig
   End If
 
    'si elle existe on remplie le tableau avec les données de l'UserForm UFEngt
End If
       With Ws
       LastLigF = .Range("A65536").End(xlUp).Row + 1
       .Range("A" & LastLigF).Value = LastLigF - 7
       .Range("B" & LastLigF).Value = Me.TxtDate.Value
       .Range("B" & LastLigF).Value = Format(Me.TxtDate, "mm-dd-yyyy")
       .Range("C" & LastLigF).Value = Me.TxtNum
       .Range("D" & LastLigF).Value = Me.CmbListeBat.Value
       .Range("E" & LastLigF).Value = Me.TxtObjet.Value
       .Range("F" & LastLigF).Value = Me.TxtNumDev.Value
       .Range("G" & LastLigF).Value = Me.TxtDevis.Value
       .Range("G" & LastLigF).Value = Format(Me.TxtDevis, "mm-dd-yyyy")
       .Range("H" & LastLigF).Value = Me.CmbListeTiers.Value
       .Range("I" & LastLigF).Value = Me.LstTiers.Value
       .Range("J" & LastLigF).Value = Me.TxtMontant.Value
       .Range("K" & LastLigF).Value = Me.TxtMarche.Value
       .Range("L" & LastLigF).Value = Me.CmbNom.Value
       End With
    Ws.Close savechanges:=True
 
    Load UFEngt
    For I = 1 To 4 'On cherche les feuilles commençant par BC
        With Sheets("BC" & I)
            'On remplie les feuilles avec les données de l'UserForm UFEngt
            .Range("B24").Value = Me.CmbListeBat.Value
            .Range("B25").Value = Me.CmbNom.Value
            .Range("D24").Value = Me.CmbNom.Value
            .Range("G6").Value = CDate(Me.TxtDate)
            .Range("H14").Value = Me.CmbListCred.Value
            .Range("N11").Value = Me.CmbListeTiers.Value
            .Range("N15").Value = Me.TxtNum.Value
            .Range("N17").Value = Me.TxtMarche.Value
            .Range("N19").Value = Me.TxtNome.Value
            .Range("A29").Value = "Selon votre devis n°" & " " & Me.TxtNumDev & " " & "du" & " " & Me.TxtDevis & " " & "ci-joint."
            End With
 
        Next I
 
        End With
    End If
    Application.ScreenUpdating = True
End Sub

**Daniel.C** · 06/02/2013, 10h35

Bonjour,

Ta macro ne peut pas s'exécuter, il y a des erreurs de syntaxe dans le déclarations de variables, un "End If" en trop...
Est-ce que la feuille "L4" existe ? Qu'est ce qui ne se produit pas ?

PS. "Ws" n'est pas non plus définie.

**NEC14** · 06/02/2013, 11h02

Bonjour Daniel.C,

La feuille L4 n'existe pas. En fait rien ne s'exécute, j'ai plein de message d'erreur, ça bug à chaque clique.

J'ai déjà utilisé mon code pour une autre application et il fonctionne, j'essaie de l'adapter à une nouvelle application en modifiant quelques paramètres, notamment la recherche de la feuille mais je n'y arrive absolument pas.

Je vais tout reprendre à zéro et voir ce que cela donne. Il faut toujours travailler dans l'urgence et cela me stresse et m'empêche de raisonner correctement.

Merci en tout cas de t'intéresser à mon problème.

**Daniel.C** · 06/02/2013, 11h08

Mets ton classeur en pièce jointe.

**NEC14** · 06/02/2013, 11h25

Il est trop gros (1 751Ko), et je ne peux pas le saucissonner. De plus, je n'ai pas d'outils pour le compresser, interdit dans ma boîte.

Désolé, à moins que tu es une autre solution.

**NEC14** · 11/02/2013, 10h34

Bonjour à tous,

Voilà après avoir tourné le code dans tous les sens et avec l'aide de Daniel, j'en suis arrivé là.
Cependant j'ai une erreur d'exécution sur la ligne en rouge.
"Erreur d'exécution 9 - L'indice n'appartient pas à la sélection"
Pourtant la feuille existe dans mon fichier.
Pouvez-vous m'éclairer s'il vous plait ? Merci par avance

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub TestA()
Dim wbkSaisie As Workbook
Dim shtFich As Worksheet
Dim LastLigF As Long, LastLigR As Long
Dim NumLig As String
Dim NewRec As Boolean, Exist As Boolean

Application.ScreenUpdating = False
Set wbkSaisie = ThisWorkbook
Set shtFich = ThisWorkbook.Sheets("L" & NumLig)
NumLig = Me.CmbListCred.Value
NumLig = 4 'pour le test
NewRec = False

 'On cherche si la feuille existe

    For Each Ws In ThisWorkbook.Worksheets   '*** ligne modifiée
        If Ws.Name = "L" & NumLig Then
Set shtFich = Ws
            Exist = True
            Exit For
        End If
    Next Ws
    If Not Exist Then
        Set shtWs = ThisWorkbook.Sheets.Add(Type:=xlWorksheet) 'Sinon on ajoute une nouvelle feuille
        shtFich.Name = "L" & NumLig
        NewRec = True
    End If


'-------------------------------------------------------
'On rapatrie les données de UFengt dans la feuille "L" & NumLig en commençant par la 7ème ligne et la colonne B

With shtFich
    LastLigF = .Range("A65536").End(xlUp).Row + 1
    .Range("A" & LastLigF).Value = LastLigF - 7
    .Range("B" & LastLigF).Value = Me.TxtDate.Value
    .Range("B" & LastLigF).Value = Format(Me.TxtDate, "mm-dd-yyyy")
    .Range("C" & LastLigF).Value = Me.TxtNum.Value
    .Range("D" & LastLigF).Value = Me.CmbListeBat.Value
    .Range("E" & LastLigF).Value = Me.TxtObjet.Value
    .Range("F" & LastLigF).Value = Me.TxtNumDev.Value
    .Range("G" & LastLigF).Value = Me.TxtDevis.Value
    .Range("G" & LastLigF).Value = Format(Me.TxtDevis, "mm-dd-yyyy")
    .Range("H" & LastLigF).Value = Me.CmbListeTiers.Value
    .Range("I" & LastLigF).Value = Me.LstTiers.Value
    .Range("J" & LastLigF).Value = Me.TxtMontant.Value
    .Range("K" & LastLigF).Value = Me.TxtMarche.Value
    .Range("L" & LastLigF).Value = Me.CmbNom.Value
End With


'---------------------------------------------------------
'Si la feuille n'existe pas on créé la feuille et ses en-têtes

With shtFich
    If NewRec Then
        .Range("A7").Value = "N°"
        .Range("B7").Value = "Date"
        .Range("C7").Value = "Engt"
        .Range("D7").Value = "Bâtiment"
        .Range("E7").Value = "Travaux réalisés"
        .Range("F7").Value = "N° Devis"
        .Range("G7").Value = "Date du devis"
        .Range("H7").Value = "Tiers"
        .Range("I7").Value = "NOM"
        .Range("J7").Value = "Montants"
        .Range("K7").Value = "Marché N°"
        .Range("L7").Value = "Engagé par"
        .Range("M7").Value = "Réalisé le"
        .Range("N7").Value = "Facture n°"
        .Range("O7").Value = "Date de la facture"
        .Range("P7").Value = "Montants"
    End If
    
    LastLigR = .Range("B65536").End(xlUp).Row + 1
    
    .Range("B" & LastLigR).Value = shtFact.Range("D" & LastLigF).Value
    .Range("C" & LastLigR).Value = shtFact.Range("I" & LastLigF).Value
    .Range("D" & LastLigR).Value = shtFact.Range("J" & LastLigF).Value
    .Range("E" & LastLigR).Value = shtFact.Range("G" & LastLigF).Value
    .Range("G" & LastLigR).Value = shtFact.Range("K" & LastLigF).Value
End With

'---------------------------------------------------------
wbkSaisie.Close Savechanges:=True

'Les données de UFengt vont dans les feuilles commençant par BC

Load UFEngt
For I = 1 To 4
    With ThisWorkbook.Sheets("BC" & I)
        .Range("B24").Value = Me.CmbListeBat.Value
        .Range("B25").Value = Me.CmbNom.Value
        .Range("D24").Value = Me.CmbNom.Value
        .Range("G6").Value = CDate(Me.TxtDate)
        .Range("H14").Value = Me.CmbListCred.Value
        .Range("N11").Value = Me.CmbListeTiers.Value
        .Range("N15").Value = Me.TxtNum.Value
        .Range("N17").Value = Me.TxtMarche.Value
        .Range("N19").Value = Me.TxtNome.Value
        .Range("A29").Value = "Selon votre devis n°" & " " & Me.TxtNumDev & " " & "du" & " " & Me.TxtDevis & " " & "ci-joint."
    End With
Next I

Set shtFich = Nothing
Set wbkSaisie = Nothing
'------------------------------------------------------------------

Application.ScreenUpdating = True
End Sub

**keygen08** · 11/02/2013, 10h49

Bonjour

Je crois qu'il te faut inverser les lignes 10 et 11
Tu appelle "numlig" alors qu'il n'est pas encore defini.

donc ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Set shtFich = ThisWorkbook.Sheets("L" & NumLig)
NumLig = Me.CmbListCred.Value
NumLig = 4 'pour le test

en cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
NumLig = Me.CmbListCred.Value
NumLig = 4 'pour le test
Set shtFich = ThisWorkbook.Sheets("L" & NumLig)

**NEC14** · 11/02/2013, 11h11

Je viens d'inverser comme annoncé, mais le problème persiste.

**keygen08** · 11/02/2013, 14h42

Le code ne renvoi pas d'erreur si la feuille en question n'est pas sélectionné.

Ou envoi une erreur si la feuille est déja selectionné.
Je suis pas sûr d'être clair.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
NumLig = Me.CmbListCred.Value
NumLig = 4 'pour le test
 feuil1.select  'en ajoutant cela pour voir
Set shtFich = Sheets("L" & NumLig)

**NEC14** · 11/02/2013, 15h09

Ok, j'essaie ça.

Toujours le même résultat, mais avec un autre message.
Erreur d'exécution "1004"
La méthode "Select" de l'objet_Worksheet a échoué

**keygen08** · 11/02/2013, 16h10

Sur quel ligne le code bloque t-il.

Si l'erreur se produit lors de l'appel de feuil1, c'est que celle ci n'existe peut etre pas.

d'ailleurs c'est bizarre, mais le code de tout a l'heure fonctionne maintenant, meme sans la modification que je t'ai proposé.

J'ai copié les 15 premieres lignes dans un module séparé
neutralisé les lignes screenupdating
et NumLig = Me.CmbListCred.Value en les passant en mode text

puis lancé la macro en mode debogage et je n'ai plus de message d'erreur.

**NEC14** · 11/02/2013, 16h29

J'ai résolu le problème, voici le code et cela fonctionne bien.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Set wbkSaisie = ThisWorkbook
NumLig = Me.CmbListCred.Value
Set shtFich = ThisWorkbook.Sheets("L" & NumLig)
shtFich.Activate

Merci à tous pour votre aide et plus particulièrement à Daniel.
René

Aide pour terminer un code qui ne fonctionne pas

Macros et VBA Excel

Discussions similaires

Partager

Partager