Type de fichier à ouvrir et importation en pourcentage

Fermé
Joelle2018 Messages postés 2 Date d'inscription lundi 1 janvier 2018 Statut Membre Dernière intervention 1 janvier 2018 - Modifié le 1 janv. 2018 à 13:03
yg_be Messages postés 22729 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 avril 2024 - 2 janv. 2018 à 10:36
Bonjour à tous,
j'ai conçu un programme qui permet de récupérer des données de plusieurs fichiers et les mettre dans un seul fichier. Jusque là tout vas bien. Cependant, les données s'importent en format texte et pas en pourcentage avec deux chiffre après la virgule. J'ai trouvée une formule sur un forum qui permettait de transformer la donnée texte en nombre, et j'ai fait un enregistrement de macro pour trouver la syntaxe de mise en pourcentage.

Premier problème: Il me mets bien les données en format texte mais pas en pourcentage ni avec deux chiffres après la virgule.
De plus, le type de fichier que je souhaite ouvrir est de type "xlsx", quand je fais une boucle avec :
For Each fichier In fichiers
        If Right(Acces_Dfatraiter & Sep & Name, 5) = ".xlsx" Then


2ème problème: je ne rentre pas dans la boucle lors de l'execution.

En vous remerciant par avance, voici mon code.


Private Sub UserForm_Click()

'Cette procédure nous permettra de récupérer le chemin du dossier "fichier-à-traiter"
    Const Sep = "\"
    Const dossieratraiter = "Fichiers-à-traiter"
    Dim BasePath As String
    Dim Acces_Dfatraiter As String
    

        BasePath = ThisWorkbook.Path 'Chemin d'accès au dossier contenant le classeur actif
        'Chemin d'accès au dossier où sera créé le fichier "Fichiers-à-traiter"
        Acces_Dfatraiter = BasePath & Sep & dossieratraiter & Sep
        'MsgBox qui me permet de tester si ma procédure est bonne
        MsgBox Acces_Dfatraiter
        
       
'Cette procédure me permet de créer un classeur excel en mémoire_
'avec le nom "Bilan-AAAA-MM-JJ-HH-MN.xlsx" (AAAA-MM-JJ-HH-MN étant les date et heure de création du fichier)
'dans le dossier "fichier générés"
    
    Const Fgeneres = "Fichiers-générés"
    Dim Acces_Dfgeneres As String, classeur As Excel.Workbook
    Dim NomFichier As String
    
         'Chemin d'accès au dossier contenant le classeur actif
        BasePath = ThisWorkbook.Path
        'Chemin d'accès au dossier où sera créé le fichier "Fichiers-générés"
        Acces_Dfgeneres = BasePath & Sep & Fgeneres & Sep
        'MsgBox qui me permet de tester si ma procédure est bonne
         MsgBox Acces_Dfgeneres
        Set classeur = Workbooks.Add
    
    NomFichier = "Bilan-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Time, "hh-mm") & ".xlsx"
    classeur.SaveAs Acces_Dfgeneres & NomFichier
    
    'je remplie mon classeur avec des données fixes, j'ajuste la longeur des colonnes
    'et je mets le format de mes cellules pourcentage avec deux chiffres après la virgule
        
        Cells(2, 1) = "Centre"
        Cells(3, 1) = "Nom"
        Cells(4, 1) = "Nom"
        Cells(1, 1) = "NomFichier"
        Workbooks(NomFichier).Sheets("Feuil1").Cells.Select
        Columns("A:E").ColumnWidth = 26
        Selection.NumberFormat = "0.00%"
        Selection.HorizontalAlignment = xlCenter
        Selection.VerticalAlignment = xlCenter
       
    'MsgBox qui me permet de tester si ma procédure est bonne
    MsgBox NomFichier

    Dim fs As Object 'filesystem
    Dim dossier As Object 'folder
    Dim fichiers As Object 'files
    Dim fichier As Excel.Workbook 'file
    Dim monClasseur As Excel.Workbook
    Dim j As Integer, col2 As String, col1 As String, col3 As String
    
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dossier = fs.GetFolder(Acces_Dfatraiter)
    Set fichiers = dossier.Files
    
    'Set fichier = Workbooks.Open("Acces_Dfatraiter & Name.xlsx*")
    
    
    Dim p As Integer, fichiersource As String, NBL As Integer, NBC As Integer
    Dim Compteur As Integer, BasePath2 As String, ContentFolderPath2 As String
            p = 0
    'p c'est un compteur qui me permettra d'incrémenter.
    'Ainsi, pour chaque fichier je recupère le nom du fichier, les noms et le centre.
    'et je décale d'une colonne à chaque fois que j'ouvre un nouveau fichier.
        Compteur = 1
    'Comme son nom l'indique, ce compteur me permet d'affecter deux procedure differents en fonction
    'de la position du fichier.
        NBC = 0
        NBL = 4

     For Each fichier In fichiers
        If Right(Acces_Dfatraiter & Sep & Name, 5) = ".xlsx" Then
            Name = fichier.Name
            Workbooks.Open fichier
            Workbooks(Name).Activate
            Workbooks(NomFichier).Sheets("Feuil1").Cells(2, 2 + p).Value = fichier(Name).Sheets("Contrôle SECURITE").Cells(3, 4).Value
            Workbooks(NomFichier).Sheets("Feuil1").Cells(3, 2 + p).Value = fichier(Name).Sheets("Contrôle SECURITE").Cells(3, 2).Value
            Workbooks(NomFichier).Sheets("Feuil1").Cells(4, 2 + p).Value = Workbooks(Name).Sheets("Contrôle SECURITE").Cells(4, 2).Value
            Workbooks(NomFichier).Sheets("Feuil1").Cells(1, 2 + p).Value = Name
               p = p + 1
        
            If Compteur = 1 Then
        'Si on ouvre le premier fichier, alors on récupère les thématiques et les pourcentages.
                Sheets("Bilan").Activate
                Dim X As Long
                Dim Y As Long, pos_th As String, pos_moy As String
                Dim ContentFolder2 As String, Ws As Worksheet
                
                X = 1
                Y = 1
        'cette procedure me permet de faire une recherche de "thématiques" et "moyenne" dans la colonne 2 et 3
        'l'une de notre première limite imposée est que les thématiques et les moyennes se mettrons uniquement dans ces deux colonnes
                While Cells(X, 2) <> "Thématique"
                  X = X + 1
                Wend
                pos_th = X
                While Cells(Y, 2) <> "Moyenne"
                  Y = Y + 1
                Wend
                pos_moy = Y
        
                For j = pos_th To pos_moy
                    Application.DisplayAlerts = False
                    col1 = Cells(j, 2).Value
                    col2 = Cells(j, 3).Value
                    
                    ContentFolder2 = Acces_Dfgeneres & NomFichier
                    Workbooks.Open (ContentFolder2)
                    
                    Set Ws = ActiveWorkbook.Worksheets("Feuil1")
   
                    While Not IsEmpty(Ws.Cells(NBL + 1, NBC + 1))
                        NBL = NBL + 1
                    Wend
        
                    Ws.Cells(NBL + 1, NBC + 1) = col1
                    Ws.Cells(NBL + 1, NBC + 2) = col2
                   
                    Ws.Cells(NBL + 1, NBC + 2).Value = Val(Cells(NBL + 1, NBC + 2).Value)
                  
                    'l'importation se faisait en format texte.
                    'Cette ligne me permet de le tranformer en nombre
                    
                    Workbooks(Name).Activate
                    Sheets("Bilan").Activate
                Next j
             End If
                NBC = NBC + 1
                
        
            If Compteur > 1 Then
        'Cette procédure s'exutera quand j'ouvrirai les fichiers suivants.
                Sheets("Bilan").Activate
                Dim W As Long
                Dim Z As Long, pos_th1 As String, pos_moy1 As String, ContentFolder3 As String, k As Integer
                
                NBL = 4
                W = 1
                Z = 1
                While Cells(W, 2) <> "Thématique"
                  W = W + 1
                Wend
                pos_th1 = W
                While Cells(Z, 2) <> "Moyenne"
                  Z = Z + 1
                Wend
                pos_moy1 = Z
                
                    
                For k = pos_th1 To pos_moy1
                    Application.DisplayAlerts = False
                    col3 = Cells(k, 3)
                    
                    ContentFolder3 = Acces_Dfgeneres & NomFichier
                    Workbooks.Open (ContentFolder3)
                    Set Ws = ActiveWorkbook.Worksheets("Feuil1")
                         
                    
                    While Not IsEmpty(Ws.Cells(NBL + 1, NBC + 1))
                        NBL = NBL + 1
                    Wend
                    
                    Ws.Cells(NBL + 1, NBC + 1) = col3
                    'cette fois je n'importe que les valeurs
                    Ws.Cells(NBL + 1, NBC + 1).Value = Val(Cells(NBL + 1, NBC + 1).Value)
                    
                    Workbooks(Name).Activate
                    Sheets("Bilan").Activate
                Next k
        
            End If
        Workbooks(Name).Close False
        'après avoir ouvert un fichier, on le ferme
        Compteur = Compteur + 1
        NBC = NBC + 0
    
     'Workbooks(NomFichier).Sheets("Feuil1").Cells.Select
  
  
       
   Next
  End Sub
A voir également:

1 réponse

yg_be Messages postés 22729 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 avril 2024 1 477
1 janv. 2018 à 14:06
bonjour, moi je ferais
        If Right(fichier.Name , 5) = ".xlsx" Then

au lieu de
        If Right(Acces_Dfatraiter & Sep & Name, 5) = ".xlsx" Then
0
yg_be Messages postés 22729 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 avril 2024 1 477
1 janv. 2018 à 14:26
et je suggère d'utiliser plutôt les déclarations suivantes:
Dim fs As Scripting.FileSystemObject
Dim dossier As Scripting.Folder
Dim fichiers As Scripting.Files
Dim fichier As Scripting.File


par ailleurs, je ne comprends pas du tout pourquoi tu utilises des variables intermédiaires pour transférer tes cellules d'un fichier à l'autre.

ton code est assez illisible, je te suggère d'utiliser deux variables pour tes feuilles sources et destination:
Dim source As Worksheet, destination As Worksheet
Set source = '...
Set destination = '...

cela te permettra de supprimer tous tes
Activate
, après avoir toujours qualifié toutes les références à des cellules (jamais
Cells
sans point devant)
0
Joelle2018 Messages postés 2 Date d'inscription lundi 1 janvier 2018 Statut Membre Dernière intervention 1 janvier 2018
1 janv. 2018 à 22:47
Je n’ai pas compris ce que tu veux m’expliquer avec le set source et destination. Tu pourrais m’expliquer pas à pas s’il te plaît ?
0
yg_be Messages postés 22729 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 avril 2024 1 477 > Joelle2018 Messages postés 2 Date d'inscription lundi 1 janvier 2018 Statut Membre Dernière intervention 1 janvier 2018
2 janv. 2018 à 10:36
surtout ajoute
option explicit
en début de module, cela te forcera à déclarer toutes tes variables.
exemple d'utilisation de source et destination:
dim classeursource as workbook
set destination = classeur.Sheets("Feuil1")
set classeursource = Workbooks.Open(fichier)
set source = classeursource.Sheets("Contrôle SECURITE")
destination.Cells(2, 2 + p).Value = source.Cells(3, 4).Value
0