Makro speichert nicht mehr ab
28.10.2007 10:33:51
andre
Hat jemand eine Idee woran es liegen könnte ?
Gruß
Andre
bis zu dieser Stelle funktioniert es
Dim Bereich As Object
Dim ZZeile As Object
Dim Zelle As Object
Dim strTemp As String
Dim intNumber As Integer
Const Dateiname As String = "Datei"
Const Extension As String = ".txt"
Const Trennzeichen As String = ";"
Const Kapselzeichen As String = ""
Set Bereich = ActiveSheet.UsedRange
Open myPath & Dateiname & "1" & Extension For Output As #1
Print #1, ""
For Each ZZeile In Bereich.Rows
intNumber = intNumber + 1
For Each Zelle In ZZeile.Cells
If InStr(1, Zelle.Text, Trennzeichen) > 0 Then
strTemp = strTemp & Kapselzeichen & CStr(Zelle.Text) & _
Kapselzeichen & Trennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & Trennzeichen
End If
Next
strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
If intNumber / 3000 = Int(intNumber / 3000) Then
Print #1, ""
Close #1
Open myPath & Dateiname & intNumber / 3000 + 1 & Extension For Output As #1
Print #1, ""
End If
Next
Print #1, ""
Close #1
Set objWS = Nothing
Set objAUSGABE = Nothing
Set rng = Nothing
End Sub
Sub Check_All()
If Range("L1").Value = True Then
Range("L1:L15").Value = False
Else
Range("L1:L15").Value = True
End If
End Sub
Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String
Dim objFlderItem As Object, objShell As Object, objFlder As Object
Set objShell = CreateObject("Shell.Application")
Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)
If objFlder Is Nothing Then GoTo ErrExit
Set objFlderItem = objFlder.Self
fncBrowseForFolder = objFlderItem.Path
ErrExit:
Set objShell = Nothing
Set objFlder = Nothing
Set objFlderItem = Nothing
End Function