Discussion :

[Invité]

Bonsoir à tous,

Je cherche une routine pour convertir depuis un dossier "TOTO" les classeurs en *.XLS en *.XLSX

Je reçois dans mon dossier "Reception" , des classeurs EXCEL , mais pour les 35/40% certains sont au format XLS, et mon programme de traitement ne prend que les XLSX (Excel 2007 ou +)

J'ai trouvé plusieurs routines qui ne sont pas en automatique et me font passer par le choix d'un dossier à traiter.

Si quelqu'un a une idée ou une solution, je suis preneur

Merci d'avance et bonne "chaude" soirée.

[kiki29]

Salut, à essayer : ceci et éventuellement à adapter à ton contexte.

[Invité]

Bonsoir à tous

Voilà ce que j'ai trouvé avec un peu d'aide

Un Btn de lancement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub CommandButton1_Click()
    Convert_XLS_to_XLSX True
End Sub

et un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Explicit
Option Private Module
 
Public Sub Convert_XLS_to_XLSX(ByVal deleteXLS As Boolean)
Dim myPath As String, myFile As String, Message As String, Title As String
Dim Style As VbMsgBoxStyle
Dim Response As VbMsgBoxResult
Dim wbk As New Workbook
 
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    myPath = "C:\Users\RECEPTION\" ' ---> chemin à adapter
 
    myFile = Dir(myPath & "*.xls")
 
    Do While myFile <> ""
       If Mid(myFile, InStrRev(myFile, ".") + 1) = "xls" Then
        Application.DisplayAlerts = False
 
        Set wbk = Workbooks.Open(Filename:=myPath & myFile)
 
        If wbk.HasVBProject Then
            wbk.SaveAs Filename:=myPath & myFile & "m", _
                    FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Else
            wbk.SaveAs Filename:=myPath & myFile & "x", _
                    FileFormat:=xlOpenXMLWorkbook
        End If
 
        wbk.Close SaveChanges:=False
 
        If deleteXLS = True Then
            With New FileSystemObject
                If .FileExists(myPath & myFile) Then
                    .DeleteFile myPath & myFile
                End If
            End With
        End If
 
        Application.DisplayAlerts = True
 
        Set wbk = Nothing
        End If
        myFile = Dir()
    Loop
 
    Application.EnableEvents = True
 
End Sub

Ca marche Nickel

Merci aux participateurs et surement @+