Macros laufen nicht mehr nach Speichern der Datei

Hallo Miteinander,
ich bin neu in disem Forum und habe gleich ein dickes Problem. Ich habe ein größeres Makro geschrieben,welches mir mit Hilfe einer Userform Daten in eine Kalkulationstabelle schreibt. Diese Datei wird dann unter einem Schlüsselnamen in ein bestimmtes Verzeichnis in meinem Netzwerk gespeichert.
Soweit klappt alles.
Meine Idee war nun mithilfe dieser abgespeicherten Datei merhrere Varianten zu erstellen, indem ich die gespeicherten Daten wieder in die Userform ziehe und einen Index hochzählen lasse. Dies alles funktioniert auch einwandfrei in der "Originaldatei".
Das Öffnen der gespeicherten Datei funktioniert auch noch ganz normal... rufe ich dann jedoch das Makro zum Befüllen der userform auf, schmiert Excel 2007 und 2010 sofort ab....Fehlermeldung "Excel funktioniert nicht mehr.......... wie gesagt in der Originaldatei funktioniert alles einwandfrei.
Und das beste wenn ich die automatische Dateiformat von xlsm auf xls stelle, funktioniert auch die Kopie einwandfrei.
Hat jemand eine Idee was das verursachen kann....nach zwei Tagen verzweifelter Suche bin ich mit meinem Latein am Ende

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo,
xlExcel8 ist für .xls Datei nicht für .xlsm
xlsx = xlOpenXMLWorkbook
xlsm = xlOpenXMLWorkbookMacroEnabled
xlsb = xlExcel12
xls = xlExcel8
Versuch mal so, Code bezieht sich auf die aktive Mappe.

Option Explicit

Sub Save_As_Version()
Dim Pfad$, Dateiname$, booIsSave As Boolean

Pfad = ThisWorkbook.Path 'Pfad anpassen 
Dateiname = ThisWorkbook.Name 'Dateiname anpassen + Extention (.xls oder .xlsm usw...) 

booIsSave = Speichern_Unter(Dateiname, Pfad)

If booIsSave Then
    MsgBox "Datei wurde gespeichert"
End If
End Sub

'Function Dialog Speichern unter ********************************************************************** 
Function Speichern_Unter(ByVal sFile_Name As String, ByVal sPath As String) As Boolean
Dim ArrFileFormat, varIndex, sExtension$, iFileFormat%
'Extension der Datei 
sExtension$ = Right$(sFile_Name, Len(sFile_Name) - InStrRev(sFile_Name, "."))
'zulässige Erweiterung, evlt. weitere hinzufügen 
ArrFileFormat = Array("xlsx", "xlsm", "xlsb", "xls") 'Datei Versionen 
varIndex = Application.Match(sExtension, ArrFileFormat, 0) 'Index für Dialog und Angabe 
     
'Formatabfrage 
iFileFormat = File_Format(sExtension$)

If iFileFormat = 0 Then
    MsgBox "Auswahl ist kein Excel File!", vbCritical
    Exit Function
End If

sPath = IIf(Right$(sPath, 1) = "\", sPath, sPath & "\")
'welche Excelversion 
On Error GoTo Error_Handler:
If Val(Application.Version) > 11 Then
    'Datei im richtigen Format speichern 
    ActiveWorkbook.SaveAs sPath & sFile_Name, iFileFormat
ElseIf iFileFormat = 56 Then
    'bis Version 11, speichern als *.xls 
    ActiveWorkbook.SaveAs sPath & sFile_Name
Else
    MsgBox "Extension kann mit dieser Excel- Version nicht gespeichert werden!", vbCritical
    Exit Function
End If

Error_Handler:
    If Err.Number = 0 Then
        Speichern_Unter = True
    Else
        MsgBox Err.Description, vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
              "Error: " & Err.Number, _
              Err.HelpFile, _
              Err.HelpContext
    End If
End Function
 
'Funktion zum ermitteln des Dateiformats ab xl2007 
'zulässige Erweiterung, evlt. weitere hinzufügen 
Private Function File_Format(sExtension$)
Select Case LCase(sExtension$)
    Case "xlsx": File_Format = 51
    Case "xlsm": File_Format = 52
    Case "xlsb": File_Format = 50
    Case "xls": File_Format = 56
End Select
End Function

Gruß Tino

Option Explicit Sub neukalk() Application.ScreenUpdating = False Range("I6").Value = Range("I6").Value + 1 'Datum aktualisieren With Range("L6") .Value = Date .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With 'Datum in String umwandeln und schreibweise Ändern Range("R6").Value = Format(Date, "yymmdd") 'Erfassungsmaske aufrufen Application.ScreenUpdating = True Datenmaske.Show End Sub

Dim i&, ii% '... For i = 10 To 19 ii = ii + 1 Cells(i, 5) = Me("txtb_Teilebez" & ii) Next i ii = 0 For i = 10 To 19 ii = ii + 1 Cells(i, 12) = Me("txtb_TK" & ii) Next i ii = 0 '... '... '...

Beliebteste Forumthreads (12 Monate)

Macros laufen nicht mehr nach Speichern der Datei

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Macros laufen nicht mehr nach Speichern der Datei

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread