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 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
| Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 18/01/2011 par Beatriz
'
'
Windows("titre décalage tpsO2 3sur4.xls").Activate
Sheets("extraction noms fichiers").Select
Range("A1").Activate
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant
With fd
.AllowMultiSelect = True
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
MsgBox vrtSelectedItem
Next
Else
End If
End With
Set fd = Nothing
Set fichcherche = Application.FileSearch
With fichcherche
.LookIn = vrtSelectedItem
.Filename = "*.oew"
If .Execute > 0 Then
For I = 1 To .FoundFiles.Count
Workbooks.OpenText Filename:=.FoundFiles(I), Origin _
:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
Set toto = ActiveSheet
Windows("titre décalage tpsO2 3sur4.xls").Activate
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
ActiveCell = toto.Name
Application.CutCopyMode = False
toto.Activate
ActiveWindow.Close
Next I
Else
MsgBox "Aucun fichier .oew n'a été trouvé."
End If
End With
MsgBox "Finiiii"
End Sub |
Partager