getopenfilename multiselect object required err#424

**benleroux** · 19/07/2008, 16h45

Bonjour,

J ai un petit soucis car je ne sais pas appeller les fichiers ouverts par l intermediaire de getopenfilename multiselect... d apres ce que j ai compris les noms des fichiers sont stockes dans un tableau, mais je n arrive pas a les appeller....

Je vous colle ma macro ci dessous...

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
Private Sub CommandButton1_Click()
  Dim vFich, sFiltre$
 
  sFiltre = "Fichiers Excel (*.xls),*.xls" ' <- ou autre...
  ChDir CurDir ' <- ou autre...
  vFich = Application.GetOpenFilename(sFiltre, MultiSelect:=True)
  If VarType(vFich) = vbBoolean Then
    Exit Sub
  Else
    For i = LBound(vFich) To UBound(vFich)
 'Ouvre les fichiers sélectionnés
  Workbooks.Open vFich(i)
  Next
  NomFichierSortie = Application.GetOpenFilename(, , "Sélectionnez votre fichier a updater")
  End If
  vFich(i).Worksheets("Feuil1").[B1].Copy _
  NomFichierSortie.Worksheets("Fiches").[A65536].End(xlUp)(2)
  vFich(i).Worksheets("Feuil1").[B2].Copy _
  NomFichierSortie.Worksheets("Fiches").[B65536].End(xlUp)(2)
  vFich(i).Worksheets("Feuil1").[B3].Copy _
  NomFichierSortie.Worksheets("Fiches").[C65536].End(xlUp)(2)
  vFich(i).Worksheets("Feuil1").[B4].Copy _
  NomFichierSortie.Worksheets("Fiches").[D65536].End(xlUp)(2)
  vFich(i).Worksheets("Feuil1").[B6].Copy _
  NomFichierSortie.Worksheets("Fiches").[E65536].End(xlUp)(2)
  vFich(i).Worksheets("Feuil1").[B5].Copy _
  NomFichierSortie.Worksheets("Emails").[A65536].End(xlUp)(2)
  vFich(i).Close
  End
End Sub

Il ya surement qqs erreur grossieres mais je debute...

J'ai aussi essaye comme cela mais erreur 424...

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 CommandButton1_Click()
    FichiersAOuvrir = Application.GetOpenFilename(, , , , True)
    If IsArray(FichiersAOuvrir) Then
    For i = LBound(FichiersAOuvrir, 1) To UBound(FichiersAOuvrir, 1)
'Ouvre les fichiers sélectionnés
    Workbooks.Open FichiersAOuvrir(i)
    NomFichierSortie = Application.GetOpenFilename(, , "Sélectionnez votre fichier a updater")
  Workbooks.Open NomFichierSortie
  FichiersAOuvrir.Worksheets("Feuil1").[B1].Copy
  NomFichierSortie.Worksheets("Fiches").[A65536].End (xlUp)
  FichiersAOuvrir.Worksheets("Feuil1").[B2].Copy _
  NomFichierSortie.Worksheets("Fiches").[B65536].End(xlUp)
  FichiersAOuvrir.Worksheets("Feuil1").[B3].Copy _
  NomFichierSortie.Worksheets("Fiches").[C65536].End(xlUp)
  FichiersAOuvrir.Worksheets("Feuil1").[B4].Copy _
  NomFichierSortie.Worksheets("Fiches").[D65536].End(xlUp)
  FichiersAOuvrir.Worksheets("Feuil1").[B6].Copy _
  NomFichierSortie.Worksheets("Fiches").[E65536].End(xlUp)
  FichiersAOuvrir.Worksheets("Feuil1").[B5].Copy _
  NomFichierSortie.Worksheets("Emails").[A65536].End(xlUp)
  Next i
  End If
  FichiersAOuvrir.Close
  End
End Sub

**zazaraignée** · 19/07/2008, 17h15

Il y a, dans la FAQ VBA, une rubrique donnant un bout de code, tout cours et tout mignon, qui semble faire le travail aisément...

Code :

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

Application.Workbooks.Open Application.GetOpenFilename()

**benleroux** · 19/07/2008, 18h00

J ai bien pris connaissance des ces applications car j utilise dans ma macro Application.GetOpenFilename()

Mais le probleme n est pas la... En faisant une selection multiple, je n arrive plus a appeller mes fichiers pour y faire mes modifications....

Code :

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

1
2
3
4
5
vFich(i).Worksheets("Feuil1").[B1].Copy _
  NomFichierSortie.Worksheets("Fiches").[A65536].End(xlUp)(2)
  vFich(i).Worksheets("Feuil1").[B2].Copy _
  NomFichierSortie.Worksheets("Fiches").[B65536].End(xlUp)(2)
  vFich(i).Worksheets("Feuil1").[B3].Copy _

NomFichierSortie appelle bien le bon fichier mais vFich ou Vfich(i) ne marche pas, de plus je ne comprend pas si je dois faire des boucles...

Merci de votre aide

**tirex28** · 20/07/2008, 00h33

Bonsoir,

vFich ou Vfich(i) ne marche pas,

Si j'en crois ton code cette variable est un variant qui contient un tableau de String. Pour accéder aux classeurs dont les chemins sont répertoriés dans ce tableau tu peux utiliser la collection Workbooks.

Code :

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

1
2
3
4
5
For i = LBound(vFich) To UBound(vFich)
    Workbooks(Dir(vFich(i))).Worksheets("Feuil1").[B1].Copy _
            NomFichierSortie.Worksheets("Fiches").[A65536].End(xlUp)(2)
 
Next

Quant à NomFichierSortie il faut la déclarer en tant que Workbook, et l'initialiser avec Set:

Code :

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

1
2
3
Dim NomFichierSortie As workBook
Set NomFichierSortie = Workbooks.Open( _
    Application.GetOpenFilename(, , "Sélectionnez votre fichier a updater"))

Il serait quand même prudent de prévoir le cas ou l'utilisateur clique sur Annuler.

Bonne chance,

Tirex28/

**benleroux** · 20/07/2008, 12h21

Merci Tirex,

Je n ai plus de message d erreur object required... et je pense que j ai compris mes erreurs mais j ai maintenant un message d erreur 9 script out of range...

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
Private Sub CommandButton1_Click()
  Dim vFich, sFiltre$
  sFiltre = "Fichiers Excel (*.xls),*.xls"
  ChDir CurDir '
  vFich = Application.GetOpenFilename(sFiltre, MultiSelect:=True)
  If VarType(vFich) = vbBoolean Then
    Exit Sub
  Else
  End If
    For i = LBound(vFich) To UBound(vFich)
  Dim NomFichierSortie As Workbook
  Set NomFichierSortie = Workbooks.Open( _
  Application.GetOpenFilename(, , "Sélectionnez votre fichier a updater"))
 
  Workbooks(Dir(vFich(i))).Worksheets("Feuil1").[B1].Copy _
  NomFichierSortie.Worksheets("Fiches").[A65536].End(xlUp)(2)
  Workbooks(Dir(vFich(i))).Worksheets("Feuil1").[B2].Copy _
  NomFichierSortie.Worksheets("Fiches").[B65536].End(xlUp)(2)
  Workbooks(Dir(vFich(i))).Worksheets("Feuil1").[B3].Copy _
  NomFichierSortie.Worksheets("Fiches").[C65536].End(xlUp)(2)
  Workbooks(Dir(vFich(i))).Worksheets("Feuil1").[B4].Copy _
  NomFichierSortie.Worksheets("Fiches").[D65536].End(xlUp)(2)
  Workbooks(Dir(vFich(i))).Worksheets("Feuil1").[B6].Copy _
  NomFichierSortie.Worksheets("Fiches").[E65536].End(xlUp)(2)
  Workbooks(Dir(vFich(i))).Worksheets("Feuil1").[B5].Copy _
  NomFichierSortie.Worksheets("Emails").[A65536].End(xlUp)(2)
  Next
  Workbooks(Dir(vFich(i))).Close
  End
End Sub

Merci de votre aide.

**tirex28** · 20/07/2008, 13h17

Bonjour,

j ai maintenant un message d erreur 9 script out of range...

Sur quelle ligne? Ton code doit pouvoir s'alleger, par exemple:

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
Dim NomFichierSortie As Workbook
Dim FeuilleSortie As Worksheet
Dim vFich, sFiltre$, i As Long
 
sFiltre = "Fichiers Excel (*.xls),*.xls"
ChDir CurDir '
vFich = Application.GetOpenFilename(sFiltre, MultiSelect:=True)
If VarType(vFich) = vbBoolean Then
    Exit Sub
End If
 
Set NomFichierSortie = Workbooks.Open( _
    Application.GetOpenFilename(, , "Sélectionnez votre fichier a updater"))
Set FeuilleSortie = NomFichierSortie.Worksheets("Fiches")
 
For i = LBound(vFich) To UBound(vFich)
    With Workbooks(Dir(vFich(i))).Worksheets("Feuil1")
        .[B1].Copy FeuilleSortie.[A65536].End(xlUp)(2)
        .[B2].Copy FeuilleSortie.[B65536].End(xlUp)(2)
        .[B3].Copy FeuilleSortie.[C65536].End(xlUp)(2)
        .[B4].Copy FeuilleSortie.[D65536].End(xlUp)(2)
        .[B6].Copy FeuilleSortie.[E65536].End(xlUp)(2)
        .[B5].Copy NomFichierSortie.Worksheets("Emails").[A65536].End(xlUp)(2)
    End With
    Workbooks(Dir(vFich(i))).Close
Next

Cordialement,

Tirex28/

**benleroux** · 20/07/2008, 13h34

Merci tirex,

J ai le message d erreur sur cette ligne

Code :

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

    With Workbooks(Dir(vFich(i))).Worksheets("Feuil1")

Meme apres avoir allege la macro avec ton aide...

Je te recolle le tout, la je suis perdu, je comprend pas bien cette 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
21
22
23
24
25
26
27
28
29
Private Sub CommandButton1_Click()
Dim NomFichierSortie As Workbook
Dim FeuilleSortie As Worksheet
Dim vFich, sFiltre$, i As Long
 
sFiltre = "Fichiers Excel (*.xls),*.xls"
ChDir CurDir '
vFich = Application.GetOpenFilename(sFiltre, MultiSelect:=True)
If VarType(vFich) = vbBoolean Then
    Exit Sub
End If
 
Set NomFichierSortie = Workbooks.Open( _
    Application.GetOpenFilename(, , "Sélectionnez votre fichier a updater"))
Set FeuilleSortie = NomFichierSortie.Worksheets("Fiches")
 
For i = LBound(vFich) To UBound(vFich)
    With Workbooks(Dir(vFich(i))).Worksheets("Feuil1")
        .[B1].Copy FeuilleSortie.[A65536].End(xlUp)(2)
        .[B2].Copy FeuilleSortie.[B65536].End(xlUp)(2)
        .[B3].Copy FeuilleSortie.[C65536].End(xlUp)(2)
        .[B4].Copy FeuilleSortie.[D65536].End(xlUp)(2)
        .[B6].Copy FeuilleSortie.[E65536].End(xlUp)(2)
        .[B5].Copy NomFichierSortie.Worksheets("Emails").[A65536].End(xlUp)(2)
    End With
    Workbooks(Dir(vFich(i))).Close
Next
  End
End Sub

Merci

getopenfilename multiselect object required err#424

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager