Programmation vba Dir probleme

Résolu/Fermé
colbubu - 17 mai 2010 à 13:12
 colbubu - 17 mai 2010 à 15:21
bonjour a tous,

en regroupant les infos du net j ai réussi a obtenir un code qui marche.... mais a moitié

voila mon petit probleme j ai un dossier avec pluieurs fichiers asc et plusieurs classeurs xlsx je souhaite prendre les asc dans excel puis les découper en tableau les copier et les coller dans le classeur excel correspondant

cependant dans le code que j ai il saute parfois un classeur et apres le dernier classeur le code FichS=Dir ne marche pas

je vous envoie une partie de mopn code pour que vous puissiez en juger

Code : 
Sub format() 
' 
' format Macro 
' 
  
'dimensionner les variables 
  
Dim objworkbooksource As Workbook 
Dim objworkbookcible  As Workbook 
Dim Repertoire        As String 
Dim FichS             As String 
Dim FichD             As String 
     
Repertoire = "C:\Users\Homer II\Documents\" 
FichS = Dir(Repertoire & "*.asc") 
FichD = Dir(Repertoire & "*.xlsx") 
Do While FichS <> "" 
     Workbooks.Open Repertoire & FichS 
  
  
  
'mettre les données .csv en tableau xl 
  
Set objworkbooksource = ActiveWorkbook 
  
     
    Columns("A:A").Select 
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
        Semicolon:=False, Comma:=True, Space:=False, Other:=False 
    Columns("A:B").Select 
    Selection.Delete Shift:=xlToLeft 
    Range("1:2,4:4,6:8").Select 
    Range("A6").Activate 
    Selection.Delete Shift:=xlUp 
     
'copier les données dans le tableau correspondant 
  
Set objworkbookcible = Application.Workbooks.Open(Repertoire & FichD) 
  
    objworkbooksource.Activate 
    Range("A3", Cells(3, 1).End(xlDown).End(xlToRight)).Copy 
     
    objworkbookcible.Activate 
    Sheets("Values").Activate 
    Range("D3").PasteSpecial 
    Application.CutCopyMode = False 
    objworkbooksource.Close savechanges:=False 
    
  
 'sauvergarder les données sous un nouvel emplacement 
  
         
        objworkbookcible.SaveAs Replace(FichD, "xlsx", "xls"), FileFormat:=xlExcel8 
        objworkbookcible.Close 
         
         
        FichS = Dir 
        FichD = Dir 
    Loop 
     
End Sub

merci pour votre aide

en fait le probleme vient du double dir en bas mais je sais pas ocmment régler ça





A voir également:

1 réponse

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
17 mai 2010 à 14:34
Bonjour,

Je n'ai pas regardé en détail mais néanmoins un point me choque.

La fonction Dir sans argument signifie trouver le fichier suivant correspondant au dernier Dir avec argument (chemin et type de fichier)

Donc mon diagnostic rapide est le suivant :

1/ FichS = Dir donne le fichier suivant .xlsx et non pas le suivant .asc

2/ FichD = Dir donne aussi encore le suivant .xlsx et donc c'est cette instruction qui la première donne un fichier vide (quand il n'y en a plus) donc l'instruction FichS = Dir dans la boucle suivante provoque une erreur.


Il faut donc imbriquer différemment la boucle pour les deux types de fichiers mais la j'ai pas fais l'exercice...

A+
0
justement c est ce que je me suis dit et ca expliquait le saut d un fichier sur 2 par contre dna sl aide ils conseillent de faire un tableau est ce que je dois le faire dans un nouveau classeur excel ou bien est ce que je peut me faire un tableau "virtuel" comme sa et récupérer les valeurs sous forme d'indexation??

merci pour ton aide
0
pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
17 mai 2010 à 15:13
Oui tu peux parfaitement faire un tableau de string dans lequel tu range les noms de fichiers.
Par contre je ne comprends pas comment se fait la correspondance entre les noms de fichiers asc et xlsx. Ont-il tout simplement le même nom avec une extension différente ?
0
non ils ont des noms différent il y a juste un nombre qui est en commun dans les deux fichiers mais la macro qui doit retrouver ce nombre et le comparer doit etre trop compliqué alors je les traite dans l'ordre et ça a l'air de marcher

je considere ce probleme comme résolu

merci pour ton aide
0