Visual Basic Frage

1234

Vice Admiral Special
Mitglied seit
04.03.2004
Beiträge
861
Renomée
1
Verfasst am:
20. Jun 2006, 11:47

- Makro richtig anpassen - funktioniert leider nicht

--------------------------------------------------------------------------------

Hallo Leude, ich bin im Netz über folgendes Makro gestolpert.
Es funktioniert auch einwandfrei, allerdings gibt es ein Problem.
Das Makro soll sich auf mehrere Tabellen beziehen können.
Beispiel:
Geöffnet sind 123.xls aaa.xls
Das Makro soll sobald es gestartet wird und das Trennzeichen und der Pfad angegeben wurde, das Trennzeichen bei allen geöffneten Excel Dateien setzen/ersetzen. Gespeichert werden soll das ganze in 123.csv
und aaa.csv

Kann mir da bitte jemand weiterhelfen?

Vielen Dank für Eure Hilfe.

Sub SaveCSV()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' mit wählbarem Trennzeichen und Maskierung von Einträgen
' von Nils@Kaczenski.de, 30.1.2003
' Ohne Gewähr!

Dim Bereich As Object, Zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String

strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")

strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", strMappenpfad)
If strDateiname = "" Then Exit Sub

strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub

Set Bereich = ActiveSheet.UsedRange

Open strDateiname For Output As #1

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next

Close #1
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname

End Sub
 
Probier mal folgenden abgeänderten Code:

Code:
Sub SaveCSV()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' mit wählbarem Trennzeichen und Maskierung von Einträgen
' von Nils@Kaczenski.de, 30.1.2003
' Ohne Gewähr!

Dim Bereich As Object, Zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String

wb = Workbooks.Count

For Each Workbook In Workbooks

Workbooks(wb).Activate
DateiNr = FreeFile
strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")

strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", strMappenpfad)
If strDateiname = "" Then Exit Sub

strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub

Set Bereich = ActiveSheet.UsedRange

Open strDateiname For Output As DateiNr

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #DateiNr, strTemp
strTemp = ""
Next

Close DateiNr
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname
wb = wb - 1
If wb = 1 Then Exit Sub
Next

End Sub

Anmerkung:
Ich gehe davon aus, dass du dieses Makro bzw. Modul in der PERSONL.XLS angelegt hast, damit du von jeder Arbeitsmappe aus Zugriff darauf hast. Wenn nicht, müßtest du die Zählvariable wb, wleche die Anzahl der offenen Arbeitsmappen speichert, dementsprechend anpassen. Die PERSONL.XLS ist dabei immer die Nummer 1, da dies zwar keine sichtbare Mappe ist, sie aber trotzdem geöffnet ist (und zwar eben immer als erste), weil darin deine persönlichen Einstellungen und Makros gespeichert sind.
 
Zurück
Oben Unten