Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
968to972
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
968to972
968to972
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Speichern unter Problem

Speichern unter Problem
20.04.2008 14:02:22
Andreas

Hallo Excelprofis!
Ich habe ein Problem mit einem bestehenden VBA-Code.
Normalerweise soll folgender Code meine Arbeitsmappe im gleichen Pfad als "Auswertung_Datum" abspeichern, das Blatt "Eingabe" und einige UserForms entfernen und nochmals speichern.
Komischerweise wird die Datei aber unter dem Aktuellen Namen gespeichert, also überschrieben.
Kann mir bitte Jemand sagen was in meinem Code geändert werden muß, damit es Funktioniert.
Option Explicit


Private Sub CommandButtonBlattAuswSich_Click()
Dim strPfad As String
strPfad = ThisWorkbook.Path & "\Auswertung_" & Format(Date, "yymmdd") & ".xls"
ThisWorkbook.SaveCopyAs strPfad
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Workbooks.Open strPfad
Application.EnableEvents = True
ActiveWorkbook.Worksheets("Eingabe").Delete
With ActiveWorkbook.VBProject
.VBComponents.Remove .VBComponents("UserForm1")
.VBComponents.Remove .VBComponents("UserformBlattAuswSicher")
With .VBComponents("DieseArbeitsmappe").CodeModule
.DeleteLines 1, .CountOfLines
End With
End With
ActiveWorkbook.Save
ThisWorkbook.Close Savechanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Danke für die Hilfe!
mfg Andreas

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Speichern unter Problem
20.04.2008 14:14:40
Andreas
Hallo nochmal!
Ich habe vergessen zu sagen, daß das Userform von einem AddIn gestartet wird. Gerade habe ich bemergt, daß doch eine neue Datei "Auswertung_Datum" angelegt wird, allerdings im Ordner, in dem das AddIn liegt.
mfg, Andreas

AW: Speichern unter Problem
20.04.2008 14:17:55
Tino
Hallo,
nicht
ThisWorkbook….
sondern
ActiveWorkbook….
Gruß
Tino

AW: Speichern unter Problem
20.04.2008 14:14:41
Tino
Hallo,
nicht
ThisWorkbook.SaveCopyAs
Sondern
ThisWorkbook.SaveAs
Gruß
Tino

AW: Speichern unter Problem
20.04.2008 14:19:13
Andreas
Hallo Tino!
Hat schon funktioniert. Allerdings habe ich immer noch das Problem, das die Kopie "Auswertung_Datum.xls" im AddIn - Ordner gespeichert wird.
Hast du eine Idee wie man das ändern kann?
Danke für die Hilfe!
mfg, Andreas

Anzeige
AW: Speichern unter Problem
20.04.2008 14:16:19
Reinhard
Hi Andreas,
mir war da zuviel Wechsel zwischen Activeworkbook und Thisworkbook, da verliert man ja leicht den Überblick, deshalb das set eingebaut.


Option Explicit
Private Sub CommandButtonBlattAuswSich_Click()
Dim strPfad As String, wkbNeu As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
strPfad = ThisWorkbook.Path & "\Auswertung_" & Format(Date, "yymmdd") & ".xls"
ThisWorkbook.SaveCopyAs strPfad
Workbooks.Open strPfad
Set wkbNeu = ActiveWorkbook
ActiveWorkbook.Worksheets("Eingabe").Delete
With wkbNeu.VBProject
.VBComponents.Remove .VBComponents("UserForm1")
.VBComponents.Remove .VBComponents("UserformBlattAuswSicher")
With .VBComponents("DieseArbeitsmappe").CodeModule
.DeleteLines 1, .CountOfLines
End With
End With
wkbNeu.Close Savechanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
ThisWorkbook.Close Savechanges:=False
End Sub

Gruß
Reinhard

Anzeige
AW: Speichern unter Problem
20.04.2008 14:28:45
Andreas
Hallo Reinhard!
Bei deinem Code besteht wieder das Problem, daß die Mappe im AddIn-Ordner gespeichert wird.
mfg, Andreas

AW: Speichern unter Problem
20.04.2008 14:28:51
Tino
Hallo,
hier mal dein Code mit Kommentaren, vielleicht verstehst du warum das so ist.


Private Sub CommandButtonBlattAuswSich_Click()
Dim strPfad As String
'ist Pfad von Add-In da ThisWorkbook auf die Mappe
'sich bezieht wo der Code läuft, muss ActiveWorkbook sein
strPfad = ThisWorkbook.Path & "\Auswertung_" & Format(Date, "yymmdd") & ".xls"
ThisWorkbook.SaveCopyAs strPfad 'Pfad von Add-In, muss ActiveWorkbook sein
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Workbooks.Open strPfad 'Pfad von Add-In, muss ActiveWorkbook sein
Application.EnableEvents = True
ActiveWorkbook.Worksheets("Eingabe").Delete
With ActiveWorkbook.VBProject
.VBComponents.Remove .VBComponents("UserForm1")
.VBComponents.Remove .VBComponents("UserformBlattAuswSicher")
With .VBComponents("DieseArbeitsmappe").CodeModule
.DeleteLines 1, .CountOfLines
End With
End With
ActiveWorkbook.Save
ThisWorkbook.Close Savechanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Gruß
Tino

Anzeige
AW: Speichern unter Problem
20.04.2008 14:33:01
Andreas
Hallo Tino!
Danke für die Hilfe! Ich teste das dann mal durch und gebe Rückantwort. Dauert aber etwas.
mfg, Andreas

AW: Speichern unter Problem
20.04.2008 17:12:28
Andreas
Hallo Tino!
Danke für die Hilfe, jetzt funktionierts. Allerdings habe ich noch ein kleines Problem. Es werden ja vor dem 2. speichern die UserForms und Module gelöscht. Das klappt auch super. Will der User aber die neu entstandene Datei nochmals sichern erscheint natürlich ein Debugger-Fehler, da die UserForms und Module nicht mehr vorhanden sind. Kann man das irgendwie abfangen?


Private Sub CommandButtonBlattAuswSich_Click()
Dim strPfad As String
strPfad = ActiveWorkbook.Path & "\Auswertung_" & Format(Date, "yymmdd") & ".xls"
ActiveWorkbook.SaveAs strPfad 'Pfad von Add-In, muss ActiveWorkbook sein
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Workbooks.Open strPfad 'Pfad von Add-In, muss ActiveWorkbook sein
Application.EnableEvents = True
ActiveWorkbook.Worksheets("Eingabe").Delete
With ActiveWorkbook.VBProject
.VBComponents.Remove .VBComponents("UserForm1")
.VBComponents.Remove .VBComponents("UserFormAuswertung")
.VBComponents.Remove .VBComponents("FormularAuswertung_oeffnen")
.VBComponents.Remove .VBComponents("FormularEingabe_oeffnen")
.VBComponents.Remove .VBComponents("Funktionen")
With .VBComponents("InterpelArbeitsmappe").CodeModule
.DeleteLines 1, .CountOfLines
End With
End With
ActiveWorkbook.Save
ThisWorkbook.Close Savechanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Danke für die Hilfe!
mfg Andreas

Anzeige
AW: Speichern unter Problem
20.04.2008 17:31:25
Tino
Hallo,
die einfachste Möglichkeit ist dies mit On Error … abzufangen.


On Error Resume Next
With ActiveWorkbook.VBProject
.VBComponents.Remove .VBComponents("UserForm1")
.VBComponents.Remove .VBComponents("UserFormAuswertung")
.VBComponents.Remove .VBComponents("FormularAuswertung_oeffnen")
.VBComponents.Remove .VBComponents("FormularEingabe_oeffnen")
.VBComponents.Remove .VBComponents("Funktionen")
With .VBComponents("InterpelArbeitsmappe").CodeModule
.DeleteLines 1, .CountOfLines
End With
End With
On Error GoTo 0


Eine zweite währe, die VBComponents in einer Schleife auf den Namen hin zu Prüfen und bei nicht vorhanden sein diesen Bereich zu überspringen.
Aber das On Error Resume Next, sollte schon den Zweck gut genug erfüllen.
Gruß
Tino

Anzeige
AW: Vielen Dank!
20.04.2008 17:39:27
Andreas
Hallo Tino!
Nochmals vielen Dank für die Hilfe, jetzt klappt alles wie es sein soll.
Ein schönes WE noch!
mfg, Andreas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige