Speichern unter
08.03.2013 08:40:08
DirkR
ich habe folgendes Macro, dass vor dem speichern Images leert, die Datei speichert und anschließend die Image wieder mit Bilder läd.
Das funktioniert auch super. Allerdings kann ich nun nicht mehr "Speichern unter" benutzen!
Ich bekomme es leider nicht hin und bitte um Hilfe!!!
Hier der Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Dim booMitImage As Boolean
Dim objShell As Object
Static BooCancel As Boolean
booMitImage = False 'False = ohne Bild speichern
Set objShell = CreateObject("WScript.Shell")
Application.ScreenUpdating = False
If Not booMitImage Then
'Dein Makro vor Speichern
Sheets("Ausweise | ID-Karten").Image1.Picture = LoadPicture("")
Sheets("Ausweise | ID-Karten").Image2.Picture = LoadPicture("")
DoEvents
End If
If Not BooCancel Then
BooCancel = True
If SaveAsUI Then 'wurde speichern unter gewählt?
Application.Dialogs(xlDialogSaveAs).Show
Else
Me.Save
End If
'Dein Makro nach speichern
Sheets("Ausweise | ID-Karten").Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Bilder\" & _
Sheets("Übersicht").Cells(157, 38).Value)
Sheets("Ausweise | ID-Karten").Image2.Picture = LoadPicture(ThisWorkbook.Path & "\Bilder\" & _
Sheets("Übersicht").Cells(157, 38).Value)
BooCancel = False
End If
If Not BooCancel Then Cancel = True: SaveAsUI = False: _
objShell.Popup "Die Datei wurde mit " & _
Round(FileLen(ThisWorkbook.FullName) / 1024, 0) & " Kilo Byte gespeichert", 2, "Die Datei _
wurde gespeichert!"
Set objShell = Nothing
Application.ScreenUpdating = True
End Sub
Gruß Dirk