AW: Datei konvertieren
16.02.2015 11:20:35
fcs
Hallo Peter,
nachfolgend ein Beispielmakro plus Konvertier-Function.
Das Beispiel-Makro ist dabei länger geworden als das eigentliche Konvertier-Makro, da Funktionen wie Bildschirmaktualisierung deaktivieren, Ereignismakros abschalten, Berechnunsmodus wechseln im Hauptmakro integriert sind, so dass man auch mehrere Dateien ohne Bildschirmfläckern in einer Schleife abarbeiten kann.
Gruß
Franz
'Makro mit AUfruf der Function kann in einem beliebigen Modul eingebaut sein.
Sub aaTest()
'Testnakro zum Blatt-Kopieren
Dim wkbQuelle As Workbook, varQuelle
Dim wkbZiel As Workbook
Dim StatusCalc As Long
'Dateiauswahl-Dialog anzeigen
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Title = "Bitte Dateien mit einzufügendem Blatt auswählen - Mehrfach-Auswahl ist möglich"
If .Show = -1 Then
Set wkbZiel = ActiveWorkbook
With Application
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'gewählte Datei(en) abarbeiten
For Each varQuelle In .SelectedItems
Set wkbQuelle = convert_to_XLSX(wkbTest:= _
Application.Workbooks.Open(Filename:=varQuelle))
With wkbZiel
wkbQuelle.Sheets(1).Copy After:=.Sheets(.Sheets.Count)
End With
wkbQuelle.Close savechanges:=False
Next
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
End With
End If
End With
End Sub
'Funktion in einem allgemeinen Code-Modul der Datei speichern
Function convert_to_XLSX(wkbTest As Workbook) As Workbook
'Speichert Dateien, die nicht im XLSX-Format vorliegen im XLSX-Format, schließt _
und öffnet die konvertierte Datei wieder.
Dim strQuelleAlt As String, strQuelleNeu As String
Select Case wkbTest.FileFormat
Case 51 '51 = xlsx-Format
'Formate die nicht in XLSX convertiert werden sollen/müssen
Set convert_to_XLSX = wkbTest
Case Else
strQuelleAlt = wkbTest.FullName
strQuelleNeu = Left(strQuelleAlt, InStrRev(strQuelleAlt, ".")) & "xlsx"
Application.DisplayAlerts = False
wkbTest.SaveAs Filename:=strQuelleNeu, FileFormat:=51
wkbTest.Close
Set convert_to_XLSX = Workbooks.Open(Filename:=strQuelleNeu)
Application.DisplayAlerts = True
End Select
End Function