ERREUR Syntaxe sur VBA

[C@thy]

Bonjour les VBistes,

me voici avec un problème de syntaxe : propriété ou méthode non gérée par cet objet (sur la ligne en rouge)

Pouvez-vous me dire ce qui ne va pas???

Set Fichiers = CreateObject("Scripting.FileSystemObject").getfolder(Chemin).Files
For Each Classeur In Fichiers
If Right(Classeur.Name, 3) = "xls" Then
If Classeur.Name <> ThisWorkbook.Name Then
ListeClasseurs.Add Classeur.Name
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = cl
cl = Dir()
End If
End If
Next

'Agrégation sans déplacement de cellules
Application.Goto Reference:="CROIX"
For Each C In Selection
On Error GoTo suit
For X = 1 To NbFichiers 'boucles sur les classeurs
Chemin = ThisWorkbook.Path
cellul = Chemin & "\" & ListeClasseurs(X) & Worksheets(1) & C.Value
If cellul= "X" Or cellul = "x" Then C = C + 1
suit:
Next X
Next C

Un grand MERCI à vous,

C@thy

 

[C@thy]

Re : ERREUR Syntaxe sur VBA

J'ai essayé ça :

Chemin = ThisWorkbook.Path
Fichier = Dir(Chemin & "\" & ListeClasseurs(X))
Feuil = Workbooks(Fichier).Worksheets(1)
cellul = Chemin & "\" & ListeClasseurs(X) & Worksheets(1) & C.Address
If C.Value = "X" Or C = "x" Then Valeur = Valeur + 1
suit:
Next X
Next C

ça marche pas non plus (l'indice n'appartient pas à la sélection... grrrr....

Bises

C@thy

 

[pierrejean]

Re : ERREUR Syntaxe sur VBA

bonjour C@thy

A mon avis le probleme est ici
Worksheets(1) & C.Value

A tester
Worksheets(1).Range(C.Address).value

 

[Bebere]

Re : ERREUR Syntaxe sur VBA

bonjour Cathy,Pierre Jean
chemin = ThisWorkbook.Path'as tu cette ligne
Set Fichiers = CreateObject("Scripting.FileSystemObject").getfold er(Chemin).Files



j'ai essayé ce code,si cela peut t'aider

Public Sub x()
Dim tableau(), x As Integer, y As Integer, Ws As Worksheet
chemin = ThisWorkbook.Path
Set Fichiers = CreateObject("Scripting.FileSystemObject").getfolder(chemin).Files
For Each Classeur In Fichiers
If Right(Classeur.Name, 3) = "xls" Then
If Classeur.Name <> ThisWorkbook.Name Then
'ListeClasseurs.Add Classeur.Name
NbFichiers = NbFichiers + 1
'cl = Dir()
ReDim Preserve tableau(1 To NbFichiers)
tableau(NbFichiers) = Classeur.Name
'cl = Dir()
End If
End If
Next

''Agrégation sans déplacement de cellules
'Application.Goto Reference:="CROIX"
'For Each C In Selection
'On Error GoTo suit
y = 0
For x = 1 To NbFichiers 'boucles sur les classeurs
Workbooks.Open Filename:=CStr(tableau(x))

For Each Ws In ActiveWorkbook.Worksheets

ThisWorkbook.ActiveSheet.Cells(x + y, "A") = chemin & "\" & tableau(x) & "." & Ws.Name ' & C.Value
y = y + 1
'If cellul = "X" Or cellul = "x" Then C = C + 1
'suit:
Next Ws
ActiveWorkbook.Close savechanges:=False
Next x
'Next C


End Sub

à bientôt

 

[C@thy]

Re : ERREUR Syntaxe sur VBA

Arf! Je me rends compte que j'aurais mieux fait de joindre mon fichier!!!

Voici le fichier de synthèse et un questionnaire rempli.
J'ai rajouté les colonnes F à K (en bleu des mers du sud, comme le cocktail Blue Lagoon pour ceux qui connaissent... très bon, et très joli aussi) pour faire mes comptages.

Merci (et salut) à vous, votre aide m'est précieuse.

Bises

C@thy

 

[C@thy]

Re : ERREUR Syntaxe sur VBA

Oups! fichier tro gro, pas passé!!!

je sépare

Edit Il s'agit de la macro Synthese

C@thy

 

[C@thy]

Re : ERREUR Syntaxe sur VBA

et l'exemple

Bises

C@thy

 

[C@thy]

Re : ERREUR Syntaxe sur VBA

je n'ai qu'une seule feuille par classeur.

Voici où j'en suis (attention, c'est peut-être pire qu'avant!!!)
Sub Synthese()
Dim Chemin$, cl$
Dim Fichiers As Object, Classeur As Object, N As Integer
Dim ListeClasseurs As New Collection
Dim C As Range
Dim Wbk As Workbook, Ws As Worksheet
Dim x As Integer, NbFichiers As Integer, y As Integer, fl As Integer
Dim Feuill As String
Dim Valeur As Double
Dim tableau() As String
Dim cellul As String
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path
cl = Dir(ThisWorkbook.Path & "\*.xls")
FichO = ActiveWorkbook.Name
Application.Goto Reference:="RAZ"
Selection.ClearContents ' on vide les données avant l'agrégation

'Recherche des Classeurs à agréger
Set Fichiers = CreateObject("Scripting.FileSystemObject").getfolder(Chemin).Files
For Each Classeur In Fichiers
If Right(Classeur.Name, 3) = "xls" Then
If Classeur.Name <> ThisWorkbook.Name Then
ListeClasseurs.Add Classeur.Name
NbFichiers = NbFichiers + 1
ReDim Preserve tableau(1 To NbFichiers)
tableau(NbFichiers) = cl
cl = Dir()
End If
End If
Next

'Agrégation sans déplacement de cellules
Application.Goto Reference:="CROIX"
For Each C In Selection
On Error GoTo suit
For x = 1 To NbFichiers 'boucles sur les classeurs
'ThisWorkbook.Sheets(1)
'[SAE.xls]Questionnaire Clauses sociales'!$C$17
Chemin = ThisWorkbook.Path
'Fichier = Dir(Chemin & "\" & ListeClasseurs(X))
fichier = Chemin & "\" & ListeClasseurs(x)
Workbooks.Open fichier
fic = ActiveWorkbook.Name
Windows(FichO).Activate

Application.Goto Reference:="COMPTAGE"
Selection.Copy

Windows(fic).Activate
Range("F15").Select
ActiveSheet.Paste
Windows(FichO).Activate

'Agrégation sans déplacement de cellules
Application.Goto Reference:="CROIX"
For Each C In Selection
On Error GoTo suit

cellul = Chemin & "\" & ListeClasseurs(x) & Worksheets(1) & C.Address.Value

If C = "X" Or C = "x" Or C = "oui" Then Valeur = Valeur + 1
suit:
Next x
Next C
Application.ScreenUpdating = True

' Application.Goto Reference:="COMPTAGE"
End Sub

Bises

C@thy

 

[C@thy]

Resolu

OK, ça fonctionne comme ceci :

Sub Synthese()
Dim Chemin$, cl$
Dim Fichiers As Object, Classeur As Object, N As Integer
Dim ListeClasseurs As New Collection
Dim C As Range
Dim Wbk As Workbook, Ws As Worksheet
Dim x As Integer, NbFichiers As Integer, y As Integer, fl As Integer
Dim Feuill As String
Dim Valeur As Double
Dim tableau() As String
Dim cellul As String
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path
cl = Dir(ThisWorkbook.Path & "\*.xls")
FichO = ActiveWorkbook.Name
Application.Goto Reference:="RAZ"
Selection.ClearContents ' on vide les données avant l'agrégation

'Recherche des Classeurs à agréger
Set Fichiers = CreateObject("Scripting.FileSystemObject").getfolder(Chemin).Files
For Each Classeur In Fichiers
If Right(Classeur.Name, 3) = "xls" Then
If Classeur.Name <> ThisWorkbook.Name Then
ListeClasseurs.Add Classeur.Name
NbFichiers = NbFichiers + 1
ReDim Preserve tableau(1 To NbFichiers)
tableau(NbFichiers) = cl
cl = Dir()
End If
End If
Next

'Agrégation sans déplacement de cellules
For x = 1 To NbFichiers 'boucles sur les classeurs
Chemin = ThisWorkbook.Path
fichier = Chemin & "\" & ListeClasseurs(x)
Workbooks.Open fichier
fic = ActiveWorkbook.Name
Windows(FichO).Activate
Application.Goto Reference:="COMPTAGE"
Selection.Copy
Windows(fic).Activate
Range("F15").Select
ActiveSheet.Paste
Windows(FichO).Activate

'Agrégation sans déplacement de cellules
Application.Goto Reference:="Formules"
For Each C In Selection
cellul = Workbooks(fic).Worksheets(1).Range(C.Address).Value
Range(C.Address) = Range(C.Address) + cellul
Next C
Application.Goto Reference:="CROIX"
For Each C In Selection
cellul = Workbooks(fic).Worksheets(1).Range(C.Address).Value
If cellul = "X" Or cellul = "x" Or cellul = "oui" Then
Range(C.Address) = Range(C.Address) + 1
End If
Next C
Workbooks(fic).Close SaveChanges:=False
Next x
Application.ScreenUpdating = True
End Sub

Merci à vous pour l'aide que vous m'avez apportée.

Bises

C@thy

 

[Bebere]

Re : ERREUR Syntaxe sur VBA

Cathy

dans ton code tu fais 3 fois la même chose(tableau,collection,cl)

'Agrégation sans déplacement de cellules
For x = 1 To NbFichiers 'boucles sur les classeurs
tu ne t'en sers pas

2 codes qui font la même chose

Public Sub x()'dans 1 tableau
Dim Fichier As String, Dossier As String,NbFichiers as integer
Dossier = ThisWorkbook.Path

Fichier = Dir(Dossier & "\" & "*.xls")
'Boucle sur les fichiers
Do While Fichier <> ""
If Right(Fichier, 3) = "xls" Then
If Fichier <> ThisWorkbook.Name Then
NbFichiers = NbFichiers + 1
ReDim Preserve tableau(1 To NbFichiers)
tableau(NbFichiers) = Fichier
End If
End If
Fichier = Dir
Loop

End Sub

Public Sub x1()'dans une collection
Dim Fichier As String, Dossier As String
Dim ListeClasseurs As New Collection

Dossier = ThisWorkbook.Path

Fichier = Dir(Dossier & "\" & "*.xls")
'Boucle sur les fichiers
Do While Fichier <> ""
If Right(Fichier, 3) = "xls" Then
If Fichier <> ThisWorkbook.Name Then
ListeClasseurs.Add Fichier
End If
End If
Fichier = Dir
Loop

End Sub

à bientôt

 

[C@thy]

Re : ERREUR Syntaxe sur VBA

Merci BEBERE,

voici la dernière version, car l'autre ne fonctionnait pas trop bien pour les colonnes de droite.

Le code n'est sans doute pas optimisé, mais ça fonctionne comme il faut, c'est déjà ça.

Sub Synthese()
Dim Chemin$, cl$
Dim Fichiers As Object, Classeur As Object, N As Integer
Dim ListeClasseurs As New Collection
Dim C As Range
Dim Wbk As Workbook, Ws As Worksheet
Dim x As Integer, NbFichiers As Integer, y As Integer, fl As Integer
Dim Feuill As String
Dim Valeur As Double
Dim tableau() As String
Dim cellul As String
  Application.ScreenUpdating = False
  Chemin = ThisWorkbook.Path
  cl = Dir(ThisWorkbook.Path & "\*.xls")
  FichO = ActiveWorkbook.Name
  Application.Goto Reference:="RAZ"
  Selection.ClearContents ' on vide les données avant l'agrégation
  
    'Recherche des Classeurs à agréger
    Set Fichiers = CreateObject("Scripting.FileSystemObject").getfolder(Chemin).Files
    For Each Classeur In Fichiers
     If Right(Classeur.Name, 3) = "xls" Then
      If Classeur.Name <> ThisWorkbook.Name Then
       ListeClasseurs.Add Classeur.Name
       NbFichiers = NbFichiers + 1
       ReDim Preserve tableau(1 To NbFichiers)
       tableau(NbFichiers) = cl
       cl = Dir()
      End If
     End If
    Next
    
'Agrégation sans déplacement de cellules
For x = 1 To NbFichiers 'boucles sur les classeurs
 Chemin = ThisWorkbook.Path
 fichier = Chemin & "\" & ListeClasseurs(x)
 Workbooks.Open fichier
 fic = ActiveWorkbook.Name
 Windows(FichO).Activate
  Range("F15:K15").Copy Destination:=Workbooks(fic).Worksheets(1).Range("F15")
 
    Application.Goto Reference:="formules"
    For Each C In Selection
     Workbooks(fic).Worksheets(1).Range(C.Address).FormulaR1C1 = "=IF(ISERROR(FIND(R15C,RC5)),"""",1)"
     cellul = Workbooks(fic).Worksheets(1).Range(C.Address).Value
     If cellul = "" Then cellul = 0
     cellulle = Workbooks(FichO).Worksheets(1).Range(C.Address).Value
      Workbooks(FichO).Worksheets(1).Range(C.Address).Value = cellulle + cellul
    Next C
  Application.Goto Reference:="CROIX"
  For Each C In Selection
    cellul = Workbooks(fic).Worksheets(1).Range(C.Address).Value
      If cellul = "X" Or cellul = "x" Or cellul = "oui" Then
        Range(C.Address) = Range(C.Address) + 1
      End If
   Next C
   Workbooks(fic).Close SaveChanges:=False
Next x
ActiveSheet.Shapes("CommandButton1").Select
    Selection.Cut
ActiveWorkbook.SaveAs Filename:= _
        "C:\Questionnaire facilitateurs Synthese.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
Application.ScreenUpdating = True
End Sub

Bises et encore merci.

C@thy

 

[Bebere]

Re : ERREUR Syntaxe sur VBA

bonjour Cathy
tu peux expliquer les Application.Goto Reference(j'ai des erreurs)
si possible mettre un des fichiers que tu ouvres
et expliquer ce que tu veux faire
à bientôy