Discussion :

[julio65]

Bonjour,

Je souhaite créer une macro, qui ouvre un des fichiers en fonction des valeurs de cellules puis qui copie certaines valeurs dans mon fichier principal. Cependant si la macro ne trouve pas le fichier alors la macro doit passer à cellule suivante par l'incrémentation de i=i+1. Je colle ci dessous la macro que j'ai écrite mais qui ne fonctionne pas...

Si vous avez des idées pour m'aider je suis preneur.

Merci beaucoup!!

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
Sub Bouton24462_Cliquer()
Dim Rep1 As Integer
i = 100
While Range("B" & i) <> ""
 
a = Range("B" & i).Value
On Error GoTo Zut
Z = "D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx"
 
Set fichier_a_ouvrir = Application.Workbooks.Open(Z, True)
c = fichier_a_ouvrir.Worksheets("Feuil1").Range("D8").Value
d = fichier_a_ouvrir.Worksheets("Feuil1").Range("E8").Value
e = fichier_a_ouvrir.Worksheets("Feuil1").Range("F8").Value
ActiveWorkbook.Close
 
Range("C" & i) = c
Range("D" & i) = d
Range("E" & i) = e
 
i = i + 1
Wend
Exit Sub
 
Zut:
i = i + 1
Resume
 
End Sub

[Patrice740]

Bonjour,

Essaies :

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
Sub Bouton24462_Cliquer()
Dim Rep1 As Integer
i = 100
While Range("B" & i) <> ""
 
  a = Range("B" & i).Value
  Z = "D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx"
 
  On Error Resume Next
  Set fichier_a_ouvrir = Application.Workbooks.Open(Z, True)
  On Error GoTo 0
  If Not fichier_a_ouvrir Is Nothing Then
    c = fichier_a_ouvrir.Worksheets("Feuil1").Range("D8").Value
    d = fichier_a_ouvrir.Worksheets("Feuil1").Range("E8").Value
    e = fichier_a_ouvrir.Worksheets("Feuil1").Range("F8").Value
    ActiveWorkbook.Close
 
    Range("C" & i) = c
    Range("D" & i) = d
    Range("E" & i) = e
  End If
  i = i + 1
 
Wend
 
End Sub

Patrice

[julio65]

Bonjour,

Merci d'avoir pris le temps de regarder à mon problème.

J'ai testé la macro mais une erreur 424 est survenue. A priori un problème sur l'objet. Il bug sur la ligne 13. mais je suppose que le problème serait le meme sur les lignes 15 et 16.

Avez vous une idée d'où cela peut provenir?

Merci.

[Patrice740]

Re,

Il faut déclarer les variables !

Code :

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

1
2
3
Sub Bouton24462_Cliquer()
Dim fichier_a_ouvrir As Workbook
....

La meilleure méthode est de déclarer toutes les variables, pour être sur de ne pas en oublier, commencer chaque module par

Code :

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

Option Explicit

Patrice

[julio65]

Re,

J'ai déclaré toutes les variables et rajouter l'Option Explicit. Cependant j'ai une nouvelle erreur sur le worksheets de la même ligne:

Le message est le suivant:

"Erreur d'exécution '-2147221080 (800401a8): La Méthode'Worksheets' de l'objet Workbook a échoué.

Cette erreur se produit lorsqu'il recherche un fichier qui n'existe pas.

As tu une idé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
26
27
28
29
30
31
32
33
34
35
36
Option Explicit
Sub Bouton24462_Cliquer()
 
Dim fichier_a_ouvrir As Workbook
Dim i As Integer
Dim c As String
Dim d As String
Dim e As String
Dim a As String
Dim z As String
 
 
i = 100
While Range("B" & i) <> ""
 
  a = Range("B" & i).Value
  z = "D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx"
 
  On Error Resume Next
  Set fichier_a_ouvrir = Application.Workbooks.Open(z, True)
  On Error GoTo 0
  If Not fichier_a_ouvrir Is Nothing Then
    c = fichier_a_ouvrir.Worksheets("Feuil1").Range("D8").Value
    d = fichier_a_ouvrir.Worksheets("Feuil1").Range("E8").Value
    e = fichier_a_ouvrir.Worksheets("Feuil1").Range("F8").Value
    ActiveWorkbook.Close
 
    Range("C" & i) = c
    Range("D" & i) = d
    Range("E" & i) = e
  End If
  i = i + 1
 
Wend
 
End Sub

[78chris]

Bonjour

Dans ce type de cas il est conseillé :

1. de tester si le fichier existe : la commande Dir est préférable à on error à mon avis
2. de tester, via une boucle, si dans ce fichier, la feuille existe

[Marc-L]

Bonjour,

vérifier l'existence d'une feuille sans boucle grâce à la fonction de feuille de calculs ESTREF, exemple ici …

[vinc_bilb]

Bonjour,

J'y vais de ma petite contribution.

La fonction ci-dessous vous permet de tester l'existence d'une feuille dans un workbook, et éventuellement de la créer via CreateSh (avec ou non confirmation suivant la valeur de Prompt_creat )

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
Function Exist_Wsh(Wbk As Workbook, WshName As String, Optional CreateSh As Boolean = False, Optional Prompt_creat As Boolean = False, Optional TabCol As Variant = vbCyan) As Boolean
'=============================================================================
' Check if a sheet exists by an access and create it if not (optional)
 
    Funcname = "Exist_Wsh"
 
    Dim Msgansw As String, Wsh As Worksheet
 
    If IsMissing(Wbk) Then Set Wbk = ActiveWorkbook
 
    On Error GoTo Err_notexist
 
        ' Set the default values
    Exist_Wsh = False
 
        ' Test by access to the sheet, return true if succeeded, or test the Error 9
    If Wbk.Worksheets(WshName).Range("A1").Address <> "" Then Exist_Wsh = True
 
Err_notexist:
 
        ' Expected Error raised when accessing to a not existing sheet
    If Err.Number = 9 Then
 
        Err.Clear
 
        Msgansw = vbOK
 
            ' Create if CreateSh = True with or without user confirmation depending on Prompt_creat
        If CreateSh = True Then
 
            If Prompt_creat = True Then
                Msgansw = MsgBox("The sheet " & WshName & " doesn't exist" & " in workbbok " & Wbk.Name & vbCrLf & _
                    "Would you like to create it?", vbExclamation + vbOKCancel, Funcname)
            End If
 
                ' Create it if not existing depending on users inputs or option
            If Msgansw <> vbCancel Or Prompt_creat = False Then
 
                Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worsheets(Wbk.Worksheets.Count))
                Wsh.Name = WshName
                Debug.Print VarType(Wsh.Tab.Color)
                Wsh.Tab.Color = TabCol
 
                    ' Test by access to the sheet, return true if succeeded
                If Wsh.Range("A1").Address <> "" Then Exist_Wsh = True
 
            End If
 
        End If
 
        Err.Clear
 
            ' Return false if another error
    Else:
        If Err.Number > 0 Then
            MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, vbCritical, Funcname
            Exist_Wsh = False
            Err.Clear
        End If
    End If
End Function

et une autre, qui permet de tester l'existence d'un fichier en passant par le File System Object (la commande 'dir' ne marche pas sur les network drives non mappés sauf erreur)

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
 
Function FSO_FileExist(ByVal FilePath As String, ByVal FileN As String) As String
'=============================================================================
' Check if a file exists through FSO
Funcname = "FSO_FolderExist"
 
Dim FSO As Scripting.FileSystemObject
 
' Init
    Set FSO = New Scripting.FileSystemObject
    FSO_FileExist = ""
 
    If FSO_FolderExist(FilePath) = False Then Exit Function
    FileN = Upd_FoldSep(FilePath) & FileN
 
' Return
    If FSO.FileExists(FileN) = True Then FSO_FileExist = FileN
    Debug.Print FileN
 
End Function

Bonne journée

[78chris]

Bonjour

Bonjour,

vérifier l'existence d'une feuille sans boucle grâce à la fonction de feuille de calculs ESTREF, exemple ici …

Nickel ! Merci

[Marc-L]

De rien !

Et cela évite les usines à gaz …

[julio65]

Bonjour Messieurs,

Merci pour vos aides, cependant j'avoue être perdu. Cela dépasse largement mes connaissances. Pouvez vous me dire comment appliquer ceci à mon code?

Merci de votre retour.

[julio65]

Je viens de trouver une solution. Avec la fonction DIR

La voici:

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
Option Explicit
Sub Bouton24462_Cliquer()
 
Dim fichier_a_ouvrir As Workbook
Dim i As Integer
Dim c As String
Dim d As String
Dim e As String
Dim a As String
Dim z As String
Dim zz As String
 
 
 
i = 100
While Range("B" & i) <> ""
 
  a = Range("B" & i).Value
  z = Dir("D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx")
 zz = "D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx"
 
 
  If z = "" Then
 
  i = i + 1
  Else
  Set fichier_a_ouvrir = Application.Workbooks.Open(zz, True)
    c = fichier_a_ouvrir.Worksheets("Feuil1").Range("D8").Value
    d = fichier_a_ouvrir.Worksheets("Feuil1").Range("E8").Value
    e = fichier_a_ouvrir.Worksheets("Feuil1").Range("F8").Value
    ActiveWorkbook.Close
 
    Range("C" & i) = c
    Range("D" & i) = d
    Range("E" & i) = e
 
  i = i + 1
 End If
Wend
 
End Sub

[Patrice740]

Bonjour,

Ça change pas le problème d'absence de feuille nommée "Feuil1" dans le classeur !
Mais si tu veux copier les valeurs de la première feuille quel que soit son nom, tu peux utiliser :

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
Option Explicit
Sub Bouton24462_Cliquer()
 
Dim fichier_a_ouvrir As Workbook
Dim i As Integer
Dim a As String
Dim z As String
Dim zz As String
 
  i = 100
  While Range("B" & i) <> ""
    a = Range("B" & i).Value
    z = Dir("D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx")
    zz = "D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx"
    If z <> "" Then
      Set fichier_a_ouvrir = Application.Workbooks.Open(zz, True)
      Range("C" & i) = fichier_a_ouvrir.Worksheets(1).Range("D8").Value
      Range("D" & i) = fichier_a_ouvrir.Worksheets(1).Range("E8").Value
      Range("E" & i) = fichier_a_ouvrir.Worksheets(1).Range("F8").Value
      ActiveWorkbook.Close
    End If
    i = i + 1
  Wend
 
End Sub

Patrice

[78chris]

Re
Si je reprends ton code du post #12 et que j'ajoute la solution de Marc-L, cela devrait marcher (à adapter si tu veux autre chose qu'un message...

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
Option Explicit
Sub Bouton24462_Cliquer()
 
Dim fichier_a_ouvrir As Workbook
Dim i As Integer
Dim c As String
Dim d As String
Dim e As String
Dim a As String
Dim z As String
Dim zz As String
 
 
 
i = 100
While Range("B" & i) <> ""
 
  a = Range("B" & i).Value
  z = Dir("D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx")
 zz = "D:\8709190L_AccesRestreint\bureau\test\S32_LM_" & a & ".xlsx"
 
 
  If z = "" Then
 
  i = i + 1
  Else
  Set fichier_a_ouvrir = Application.Workbooks.Open(zz, True)
  if ExistWorkbookSheet(fichier_a_ouvrir.name, "Feuil1") then
    c = fichier_a_ouvrir.Worksheets("Feuil1").Range("D8").Value
    d = fichier_a_ouvrir.Worksheets("Feuil1").Range("E8").Value
    e = fichier_a_ouvrir.Worksheets("Feuil1").Range("F8").Value
 
    Range("C" & i) = c
    Range("D" & i) = d
    Range("E" & i) = e
    
   ActiveWorkbook.Close
else
  msg="Feuil1 introuvable"
endif
  i = i + 1
 End If
Wend
 
End Sub

Code :

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

1
2
3
4
Function ExistWorkbookSheet(CLASSEUR, FEUILLE) As Boolean
                          V = Evaluate("ISREF('[" & CLASSEUR & "]" & FEUILLE & "'!A1)")
         ExistWorkbookSheet = IIf(IsError(V), False, V)
End Function