getopenfilename multiselect object required err#424

Version imprimable

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:

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:

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

19/07/2008, 17h15
zazaraignée

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:

Application.Workbooks.Open Application.GetOpenFilename()

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:

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

20/07/2008, 00h33
tirex28
Bonsoir,

Citation:

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:

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:

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/

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:

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.

Bonjour,

Citation:

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

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

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
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/

Merci tirex,

J ai le message d erreur sur cette ligne

Code:

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:

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

Bonjour,

Il te manque l'ouverture (puis fermeture ) du fichier à traiter dans ta boucle ..
du genre :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Dim wk as workbook
(....)
 
For i = LBound(vFich) To UBound(vFich)
set wk= workbooks.open(vFich(i))
With wk.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
wk.close, False 'Ferme sans sauve 
Next
(..)
Next

20/07/2008, 13h53
benleroux

Merci a tous, ca marche nikel

Benoit