probleme de macro excel 2007 et pas sur 2003

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
D

Defcom60

XLDnaute Junior
Bonjour,

j'ai crée un macros sur excel 2003 elle fonctionne bien je voulais l'utilisr sur excel 2007 mais elle ne fonctionne plus voici une partie du code.

Code: 
Sub BrowsingForFolder()
Dim SelectedPathFolder As String
Dim concentrateur As String

second1 = second(Time)

    On Error Resume Next
    Workbooks("temp.xls").Close savechanges:=False


     Application.EnableEvents = False
On Error GoTo creation
    Workbooks.Open Filename:=ThisWorkbook.Path & "\temp\temp.xls": On Error GoTo 0: GoTo fin
creation:
     Workbooks.Add
     ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\temp\temp.xls"
fin:
    Application.EnableEvents = True
    On Error Resume Next
    Worksheets("Feuil1").AutoFilterMode = False
    Workbooks("temp.xls").Sheets("Feuil1").Cells().ClearContents
    Workbooks("temp.xls").Sheets("Feuil1").Select

Select Case Tour
Case "B1"
concentrateur = "0008"
Case "TA" To "TB"
    Select Case Etages
    Case 0 To 4
    concentrateur = "0004"
    Case 5 To 9
    concentrateur = "0509"
    Case 10 To 14
    concentrateur = "1014"
    Case 15 To 19
    concentrateur = "1519"
    Case 20 To 24
    concentrateur = "2024"
    Case 25 To 29
    concentrateur = "2529"
    Case 30 To 34
    concentrateur = "3034"
    Case 35 To 39
    concentrateur = "3539"
    End Select

End Select
    concentrateurs = concentrateur
    SelectedPathFolder = Workbooks(ThisWorkbook.Name).Sheets("config").Range("A46").Value & "\" & Tour & concentrateur
    OpeningFiles SelectedPathFolder
    
End Sub

Sub OpeningFiles(SelectedFolder As String)
Dim TxtFile As Variant, mystr As String, Datefichier As String, DateActuelle As String, DateAuto As String, precedentedate As String
Dim heuresauvegarde As String, mystr2 As String, mystr3 As String, heuresauvegarde2 As String
Dim k, l As Integer
Dim mystr4 As String

With Application.FileSearch
   .NewSearch
   .Filename = "*.TXT"
   .LookIn = SelectedFolder
   .Execute
   .SearchSubFolders = False

   
   fichiervide = 1

For Each TxtFile In .FoundFiles
             Datefichier = Right(TxtFile, 17)
             mystr = Mid(Datefichier, 1, 8)
             DateActuelle = Format(Date, "ddmmyyyy")
             precedentedate = Format(precedentdate, "ddmmyyyy")
             
            
If config.CheckBox1.Enabled = True And sauvegardeautomatique = 1 Then
 If Format(Time, "h:mm:ss") > Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("C2").Value, "hh:mm") And Format(Time, "hh:mm:ss") < Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("D2").Value, "hh:mm:ss") Then
   heuresauvegarde = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("C2"), "hhmm")
   heuresauvegarde2 = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("E2"), "hhmm")


   Else
   heuresauvegarde = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("D2"), "hhmm")
   heuresauvegarde2 = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("F2"), "hhmm")
   End If
DateAuto = Right(TxtFile, 17)
mystr = Mid(Datefichier, 1, 13)
mystr2 = Format(Date, "ddmmyyyy") & "_" & heuresauvegarde
mystr3 = Format(Date, "ddmmyyyy") & "_" & heuresauvegarde2
            
If mystr2 = mystr Or mystr3 = mystr Then ImportTXT TxtFile, Dir(TxtFile)
             
End If
        
       
             
If DateActuelle = mystr And testprecendentdate = 0 Then ImportTXT TxtFile, Dir(TxtFile)

If precedentedate = mystr And testprecendentdate = 1 Then ImportTXT TxtFile, Dir(TxtFile)


Next TxtFile
End With


End Sub

la macros s'arrête sans erreur à la ligne With Application.FileSearch
et retour à la procédure precédente sur la ligne end sub.

merci de votre aide.
 
Trier par date Trier par votes
Re : probleme de macro excel 2007 et pas sur 2003

merci pour cette reponse j'ai commencer à modifier le code comme cela

Code: 
Sub BrowsingForFolder()
Dim SelectedPathFolder As String
Dim concentrateur As String

second1 = second(Time)

    On Error Resume Next
    Workbooks("temp.xls").Close savechanges:=False


     Application.EnableEvents = False
On Error GoTo creation
    Workbooks.Open Filename:=ThisWorkbook.Path & "\temp\temp.xls": On Error GoTo 0: GoTo fin
creation:
     Workbooks.Add
     ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\temp\temp.xls"
fin:
    Application.EnableEvents = True
    On Error Resume Next
    Worksheets("Feuil1").AutoFilterMode = False
    Workbooks("temp.xls").Sheets("Feuil1").Cells().ClearContents
    Workbooks("temp.xls").Sheets("Feuil1").Select

Select Case Tour
Case "B1"
concentrateur = "0008"
Case "TA" To "TB"
    Select Case Etages
    Case 0 To 4
    concentrateur = "0004"
    Case 5 To 9
    concentrateur = "0509"
    Case 10 To 14
    concentrateur = "1014"
    Case 15 To 19
    concentrateur = "1519"
    Case 20 To 24
    concentrateur = "2024"
    Case 25 To 29
    concentrateur = "2529"
    Case 30 To 34
    concentrateur = "3034"
    Case 35 To 39
    concentrateur = "3539"
    End Select

End Select
    concentrateurs = concentrateur
    SelectedPathFolder = Workbooks(ThisWorkbook.Name).Sheets("config").Range("A46").Value & "\" & Tour & concentrateur
    OpeningFiles SelectedPathFolder
    
End Sub

Sub OpeningFiles(SelectedFolder As String)
Dim TxtFile As Variant, mystr As String, Datefichier As String, DateActuelle As String, DateAuto As String, precedentedate As String
Dim heuresauvegarde As String, mystr2 As String, mystr3 As String, heuresauvegarde2 As String
Dim k, l As Integer
Dim mystr4 As String
Dim Recherche As ClFileSearch.ClasseFileSearch
Dim i As Long
Set Recherche = ClFileSearch.Nouvelle_Recherche
 
With Recherche
    'Définit le répertoire de recherche
    .FolderPath = SelectedFolder
    '.Filename = "*.TXT"
    'Définit la recherche dans les sous dossiers (True / False)
    .SubFolders = False
 
    'Option de tri:
    '(Sort_None, sort_Name, sort_Path, sort_Size, sort_DateCreated, sort_LastModified, sort_Type)
    'Pas de tri si le paramètre n'est pas spécifié.
    .SortBy = sort_Name
 
    'Option pour rechercher un type de fichier
    '(Renvoie tous les fichiers si non spécifié)
    .Extension = "*.txt"
 
    'Execute la recherche
    .Execute
   
   fichiervide = 1
For Each TxtFile In .FoundFiles

             Datefichier = Right(TxtFile, 17)
             mystr = Mid(Datefichier, 1, 8)
             DateActuelle = Format(Date, "ddmmyyyy")
             precedentedate = Format(precedentdate, "ddmmyyyy")
             
            
If config.CheckBox1.Enabled = True And sauvegardeautomatique = 1 Then
 If Format(Time, "h:mm:ss") > Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("C2").Value, "hh:mm") And Format(Time, "hh:mm:ss") < Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("D2").Value, "hh:mm:ss") Then
   heuresauvegarde = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("C2"), "hhmm")
   heuresauvegarde2 = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("E2"), "hhmm")


   Else
   heuresauvegarde = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("D2"), "hhmm")
   heuresauvegarde2 = Format(Workbooks(ThisWorkbook.Name).Sheets("config").Range("F2"), "hhmm")
   End If
DateAuto = Right(TxtFile, 17)
mystr = Mid(Datefichier, 1, 13)
mystr2 = Format(Date, "ddmmyyyy") & "_" & heuresauvegarde
mystr3 = Format(Date, "ddmmyyyy") & "_" & heuresauvegarde2
            
If mystr2 = mystr Or mystr3 = mystr Then ImportTXT TxtFile, Dir(TxtFile)
             
End If
        
       
             
If DateActuelle = mystr And testprecendentdate = 0 Then ImportTXT TxtFile, Dir(TxtFile)

If precedentedate = mystr And testprecendentdate = 1 Then ImportTXT TxtFile, Dir(TxtFile)

Next TxtFile
End With
Set Recherche = Nothing

End Sub

Sub ImportTXT(TxtFile As Variant, TXTname As String)
Dim Record As String
Dim Container As Variant
Dim i As Double, ii As Byte
Dim derligne As Double


fichiervide = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False


derligne = Range("a65536").End(xlUp).Row
Range("A" & derligne + 1 & "").Select

Open TxtFile For Input As #1
    i = derligne
    Do While Not EOF(1)
        
        i = i + 1
        Line Input #1, Record
        Container = Split(Record, Chr(9)) '9 = "Tab"
            For ii = 1 To 5
                    On Error Resume Next
                    Cells(i, ii) = Application.WorksheetFunction.Substitute(Container(ii - 1), "'", "")
            Next ii
            
    Loop
Close #1




Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

maintenant je coince a cette ligne
For Each TxtFile In .FoundFiles
le .FoundFiles me pause problème car il n'existe plus sur 2007
je ne vois pas comment adapter le code

merci de votre aide.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
562
JJ69
J
E
  • Question Question
XL 2016 probleme sur un code : enregistrement d'un fichier excel en csv avec séparateur ;
Réponses
0
Affichages
913
Excelo92
E
M
  • Question Question
XL pour MAC excel 2011 à 2016 : gros ralentissement macro et bug bouton
Réponses
3
Affichages
1 K
Staple1600
Staple1600
AlCapone
  • Question Question
Probleme de format nombre dans fichier txt apres export via macro excel
Réponses
3
Affichages
2 K
AlCapone
AlCapone
S
  • Question Question
Ouverture de page et macro qui ne se fini pas
Réponses
5
Affichages
1 K
shana00
S
B
  • Question Question
Problèmes de macro liés à l'extraction et à l'envoi d'un fichier
Réponses
0
Affichages
1 K
benadry
B
C
  • Question Question
[Résolu]Conversion entre excel 2007 et 2003
2
Réponses
26
Affichages
20 K
Roland_M
Roland_M
X
  • Question Question
Problème macro 2003 sur excel 2007
Réponses
0
Affichages
6 K
xblade
X
G
  • Question Question
plus de 3 MFC sous excel 2003
Réponses
2
Affichages
1 K
greghennequin
G
F
  • Question Question
macro fonctionne sous excel 2003 mais pas 2007
Réponses
12
Affichages
2 K
faroukal
F
_matt_44
  • Question Question
[MACRO] Transfer de excel 2003 vers excel 2007
Réponses
3
Affichages
4 K
_matt_44
_matt_44
Retour