Bonjour,
Je souhaiterais savoir comment marche cette macro, étape par étape.
Merci d'avance :
Dim Nom_Fichier(1 To 1000) As Variant
Dim Client(1 To 1000) As Variant
Private Sub CommandButton1_Click()
Dim lItem, Le_FichierOUVERT, NomDossier
Dim fichierOUVERT As String
FICHIER_PROCEDURE = ThisWorkbook.Name
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
Le_Fichier_Choisi = ListBox1.List(lItem)
ListBox1.Selected(lItem) = False
Exit For
End If
Next
fichierOUVERT = "non"
For Each Le_FichierOUVERT In Application.Workbooks 'On parcours chacun des classeurs Excel ouverts.
If Le_FichierOUVERT.Name = Le_Fichier_Choisi & ".xlsx" Then 'Vérifie s'il n'est pas déjà ouvert.
fichierOUVERT = "oui" 'Switch
Exit For 'Sort de la boucle
End If
Next Le_FichierOUVERT 'Passe au prochain fichier
NomDossier = Application.Workbooks(ThisWorkbook.Name).Sheets("paramétres").Cells(1, 4).Value
If Right(NomDossier, 1) <> "\" Then NomDossier = NomDossier & "\"
If fichierOUVERT <> "oui" Then 'Une fois la boucle complétée, si la Switch n'a pas été tournée à oui, alors ouvre le fichier
Set Le_FICHIER = Workbooks.Open(Filename:=NomDossier & Le_Fichier_Choisi, UpdateLinks:=0)
End If
Le_Nom_Fichier_1 = Le_Fichier_Choisi & ".xlsx"
Me.Hide
Unload Me
End Sub
Private Sub CommandButton2_Click()
Me.Hide
Unload Me
End
End Sub
Private Sub Userform_initialize()
Dim FSO As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer
Application.ScreenUpdating = False
FICHIER_PROCEDURE = ThisWorkbook.Name
On Error GoTo Fin
Set FSO = CreateObject("Scripting.FileSystemObject")
NomDossier = Application.Workbooks(ThisWorkbook.Name).Sheets("paramétres").Cells(1, 4).Value
If Right(NomDossier, 1) <> "\" Then NomDossier = NomDossier & "\"
If NomDossier = "" Then Exit Sub
Set Dossier = FSO.GetFolder(NomDossier)
Set Files = Dossier.Files
i = 0
If Files.Count <> 0 Then
For Each File In Files
i = i + 1
Nom_Fichier(i) = File.Name
Cellule = Nom_Fichier(i)
If Right(Cellule, 5) = ".xlsx" Then Cellule = Mid(Cellule, 1, Len(Cellule) - 5)
Nom_Fichier(i) = Cellule
Me.ListBox1.AddItem Nom_Fichier(i)
Next
End If
Exit Sub
Fin:
On Error GoTo 0
End
End Sub
Je souhaiterais savoir comment marche cette macro, étape par étape.
Merci d'avance :
Dim Nom_Fichier(1 To 1000) As Variant
Dim Client(1 To 1000) As Variant
Private Sub CommandButton1_Click()
Dim lItem, Le_FichierOUVERT, NomDossier
Dim fichierOUVERT As String
FICHIER_PROCEDURE = ThisWorkbook.Name
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
Le_Fichier_Choisi = ListBox1.List(lItem)
ListBox1.Selected(lItem) = False
Exit For
End If
Next
fichierOUVERT = "non"
For Each Le_FichierOUVERT In Application.Workbooks 'On parcours chacun des classeurs Excel ouverts.
If Le_FichierOUVERT.Name = Le_Fichier_Choisi & ".xlsx" Then 'Vérifie s'il n'est pas déjà ouvert.
fichierOUVERT = "oui" 'Switch
Exit For 'Sort de la boucle
End If
Next Le_FichierOUVERT 'Passe au prochain fichier
NomDossier = Application.Workbooks(ThisWorkbook.Name).Sheets("paramétres").Cells(1, 4).Value
If Right(NomDossier, 1) <> "\" Then NomDossier = NomDossier & "\"
If fichierOUVERT <> "oui" Then 'Une fois la boucle complétée, si la Switch n'a pas été tournée à oui, alors ouvre le fichier
Set Le_FICHIER = Workbooks.Open(Filename:=NomDossier & Le_Fichier_Choisi, UpdateLinks:=0)
End If
Le_Nom_Fichier_1 = Le_Fichier_Choisi & ".xlsx"
Me.Hide
Unload Me
End Sub
Private Sub CommandButton2_Click()
Me.Hide
Unload Me
End
End Sub
Private Sub Userform_initialize()
Dim FSO As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer
Application.ScreenUpdating = False
FICHIER_PROCEDURE = ThisWorkbook.Name
On Error GoTo Fin
Set FSO = CreateObject("Scripting.FileSystemObject")
NomDossier = Application.Workbooks(ThisWorkbook.Name).Sheets("paramétres").Cells(1, 4).Value
If Right(NomDossier, 1) <> "\" Then NomDossier = NomDossier & "\"
If NomDossier = "" Then Exit Sub
Set Dossier = FSO.GetFolder(NomDossier)
Set Files = Dossier.Files
i = 0
If Files.Count <> 0 Then
For Each File In Files
i = i + 1
Nom_Fichier(i) = File.Name
Cellule = Nom_Fichier(i)
If Right(Cellule, 5) = ".xlsx" Then Cellule = Mid(Cellule, 1, Len(Cellule) - 5)
Nom_Fichier(i) = Cellule
Me.ListBox1.AddItem Nom_Fichier(i)
Next
End If
Exit Sub
Fin:
On Error GoTo 0
End
End Sub