1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
| Private Sub ExportDatas(Optional ByVal SheetName As String, Optional ByVal Column As String, Optional ByRef Workbook As Excel.Workbook)
If Workbook Is Nothing Then Set Workbook = ThisWorkbook
If Column = vbNullString Then Column = "A"
If SheetName = vbNullString Then SheetName = "Feuil1"
On Error GoTo Catch
Application.ScreenUpdating = False
With Workbook
Dim itemRange As Excel.Range
For Each itemRange In .Worksheets(SheetName).Range(Column & "1:" & Column & .Worksheets(SheetName).Range(Column & Application.Rows.Count).End(xlUp).Row)
If StrComp(itemRange.Value, "oui", vbTextCompare) = 0 Then
If Dir(itemRange.Offset(0, 1).Value, vbNormal) > vbNullString Then
Dim itemWorkbook As Excel.Workbook
Set itemWorkbook = Workbooks.Open(itemRange.Offset(0, 1).Value)
With itemWorkbook
.Windows(1).Visible = False
'Todo " Faire quelque-chose."
Debug.Print .Worksheets("Feuil1").Range("A1").Value
.Close SaveChanges:=False
Set itemWorkbook = Nothing
Dim importCounter As Long
importCounter = importCounter + 1
End With
Else
Debug.Print "Le fichier : " & itemRange.Offset(0, 1).Value & " est introuvable !"
End If
End If
Next itemRange
Debug.Print "-------------"
Debug.Print "Importation terminée : " & importCounter & " Classeur" & IIf(importCounter > 1, "s ont été importés.", " a été importés.")
End With
Catch:
If Err.Number > 0 Then
'Todo "Faire quelque chose."
Debug.Print "Oupss... Nous avons rencontré une erreur : " & Err.Description
End If
Application.ScreenUpdating = True
End Sub |
Partager