Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1680to1684
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
VBA - Speichern unter
27.03.2019 08:00:29
Kai
Guten Morgen zusammen,
ich benötige mal Eure Hilfe bei dem folgenden VBA-Code, welches ich mir zusammen gebastelt habe.
Ich möchte eigentlich, dass die Tabellenblätter aus einer Arbeitsmappe in eine neue Arbeitsmappe geschrieben werden, und diese neue Arbeitsmappe soll dann in ein variables Verzeichnis gespeichert werden, also über Speichern unter.
Nun erstellt er nur die neue Arbeitsmappe, Speichern unter geht auf und wenn ich den Pfad eingegeben habe, ist die gespeicherte Arbeitsmappe leer und es ist noch eine Arbeitsmappe da ....
Ausserdem wäre es noch schön, wenn zum Schluß eine Checkbox kommen würde, die dann besagt, dass die neue ARbeitsmappe erstellt und gespeichert wurde. Diese checkbox dann einfach mit OK bestätigen oder so :)
Wäre super, wenn man mir helfen könnte, ich quäle mich durch zig Seiten, finde aber keine Lösung.
Danke für Eure Hilfe.
Gruß Kai
Sub Speichernunter2()
Dim wkbMappe As Workbook
Dim VarPfad As Variant
Dim strOrdner As String
Dim vntBlattName As Variant
Application.DisplayAlerts = False
vntBlattName = Array("PR Master Header", "PR Master Recoveries", "PR Master Prepayments", "PR   _
_
Master Accounting", "PR Master Interest")
Sheets(vntBlattName).Copy
Set wkbMappe = Workbooks.Add
Set VarPfad = Application.FileDialog(msoFileDialogSaveAs)
With VarPfad
.Title = "Wählen Sie das Verzeichnis aus"
.ButtonName = "Speichern..."
.InitialFileName = ThisWorkbook.Path & "\" & wkbMappe.Name
If .Show  -1 Then
Exit Sub
End If
strOrdner = .SelectedItems(1)
End With
wkbMappe.SaveAs strOrdner
wkbMappe.Close
Application.DisplayAlerts = True
End Sub

26
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Speichern unter
27.03.2019 08:18:50
Torsten
Hallo Kai,
aender diese Zeile:

Set wkbMappe = Workbooks.Add

um in:

Set wkbMappe = ActiveWorkbook

sonst wird hier immer noch ein neues leeres Workbook erstellt und das speicherst du dann ab.
Gruss Torsten
AW: VBA - Speichern unter
27.03.2019 08:28:45
Kai
Danke, hat funktioniert.
Was mir aber noch auffällt, wenn die neuen Mappe erstellt/kopiert wird, sollen nur die Werte enthalten sein, keine Verknüpfungen zu Datenquellen.
Gibt es hier auch eine Lösung?
AW: VBA - Speichern unter
27.03.2019 08:52:34
Dieter(Drummer)
Hallo Kai,
dann musst du die die kopierten Formeln und Verknüpfungen eben in absolute Werte umwandeln.
... Nur so eine Idee ...
Gruß, Dieter(Drummer)
Anzeige
AW: VBA - Speichern unter
27.03.2019 08:54:36
Kai
Hi Dieter,
ja - aber ich weiß leider nicht, wie das per VBA funktioniert :(
Gruß Kai
AW: VBA - Speichern unter
27.03.2019 08:55:35
Torsten
Hallo Kai,
also wenn wirklich nur Werte kopiert werden sollen dann so, aber auch alle Formeln sind dann weg in der neuen Datei.

Sub Speichernunter2()
Dim wkbMappe As Workbook
Dim VarPfad As Variant
Dim strOrdner As String
Dim vntBlattName As Variant
Dim WS As Worksheet
Application.DisplayAlerts = False
vntBlattName = Array("Sheet1", "Sheet2")
Sheets(vntBlattName).Copy
Set wkbMappe = ActiveWorkbook
Set VarPfad = Application.FileDialog(msoFileDialogSaveAs)
With VarPfad
.Title = "Wählen Sie das Verzeichnis aus"
.ButtonName = "Speichern..."
.InitialFileName = ThisWorkbook.Path & "\" & wkbMappe.Name
If .Show  -1 Then
Exit Sub
End If
strOrdner = .SelectedItems(1)
End With
For Each WS In wkbMappe.Worksheets
WS.Cells.Copy
WS.Range("A1").PasteSpecial Paste:=xlValues
Next WS
Application.CutCopyMode = False
wkbMappe.SaveAs strOrdner
wkbMappe.Close
Application.DisplayAlerts = True
End Sub
Gruss Torsten
Anzeige
AW: VBA - Speichern unter
27.03.2019 09:10:35
Daniel
Oder so, dann werden nur die Verknüpfungen gelöscht, die anderen Formeln bleiben erhalten.
Sub Speichernunter2()
Dim wkbMappe As Workbook
Dim VarPfad As Variant
Dim strOrdner As String
Dim vntBlattName As Variant
Dim WS As Worksheet
Dim objConnection As Variant
Application.DisplayAlerts = False
vntBlattName = Array("Sheet1", "Sheet2")
Sheets(vntBlattName).Copy
Set wkbMappe = ActiveWorkbook
Set VarPfad = Application.FileDialog(msoFileDialogSaveAs)
With VarPfad
.Title = "W?hlen Sie das Verzeichnis aus"
.ButtonName = "Speichern..."
.InitialFileName = ThisWorkbook.Path & "\" & wkbMappe.Name
If .Show  -1 Then
Exit Sub
End If
strOrdner = .SelectedItems(1)
End With
For Each objConnection In wkbMappe.Connections
objConnection.Delete
Next objConnection
wkbMappe.SaveAs strOrdner
wkbMappe.Close
Application.DisplayAlerts = True
End Sub
Gruß
Daniel
Anzeige
AW: VBA - Speichern unter
27.03.2019 09:29:07
Kai
Hi Daniel,
leider kachelt es jetzt ab, mit dem folgenden Fehler:
Laufzeitfehler 5
Ungültiger Prozeduraufrauf oder ungültiges Argument
Der VBA bleibt hier hängen:
For Each objConnection In wkbMappe.Connections
--> objConnection.Delete
Hier nochmals der eingehängte VBA-Code:
Sub Speichernunter_NEU()
Dim wkbMappe As Workbook
Dim VarPfad As Variant
Dim strOrdner As String
Dim vntBlattName As Variant
Dim WS As Worksheet
Dim objConnection As Variant
Application.DisplayAlerts = False
vntBlattName = Array("PR Master Header", "PR Master Recoveries", "PR Master Prepayments", "PR  _
Master Accounting", "PR Master Interest")
Sheets(vntBlattName).Copy
Set wkbMappe = ActiveWorkbook
Set VarPfad = Application.FileDialog(msoFileDialogSaveAs)
With VarPfad
.Title = "W?hlen Sie das Verzeichnis aus"
.ButtonName = "Speichern..."
.InitialFileName = ThisWorkbook.Path & "\" & wkbMappe.Name
If .Show  -1 Then
Exit Sub
End If
strOrdner = .SelectedItems(1)
End With
For Each objConnection In wkbMappe.Connections
objConnection.Delete
Next objConnection
wkbMappe.SaveAs strOrdner
wkbMappe.Close
Application.DisplayAlerts = True
End Sub

Anzeige
AW: VBA - Speichern unter
27.03.2019 10:13:05
Daniel
Dann so:
Sub Speichernunter_NEU()
Dim wkbMappe As Workbook
Dim VarPfad As Variant
Dim strOrdner As String
Dim vntBlattName As Variant
Dim WS As Worksheet
Dim alleLinks As Variant
Dim i As Long
Application.DisplayAlerts = False
vntBlattName = Array("PR Master Header", "PR Master Recoveries", "PR Master Prepayments", "PR  _
Master Accounting", "PR Master Interest")
Sheets(vntBlattName).Copy
Set wkbMappe = ActiveWorkbook
Set VarPfad = Application.FileDialog(msoFileDialogSaveAs)
With VarPfad
.Title = "W?hlen Sie das Verzeichnis aus"
.ButtonName = "Speichern..."
.InitialFileName = ThisWorkbook.Path & "\" & wkbMappe.Name
If .Show  -1 Then
Exit Sub
End If
strOrdner = .SelectedItems(1)
End With
alleLinks = wkbMappe.LinkSources()
If Not IsEmpty(alleLinks) Then
For i = UBound(alleLinks) To 1 Step -1
ThisWorkbook.BreakLink alleLinks(i)
Next
End If
wkbMappe.SaveAs strOrdner
wkbMappe.Close
Application.DisplayAlerts = True
End Sub

Anzeige
AW: VBA - Speichern unter
27.03.2019 10:21:04
Kai
Leider bleibt er wieder hängen:
Fehler beim Kompilieren:
Argument ist nicht optional
alleLinks = wkbMappe.LinkSources()
If Not IsEmpty(alleLinks) Then
For i = UBound(alleLinks) To 1 Step -1
ThisWorkbook.BreakLink alleLinks(i)
bleibt in der letzten Zeile bei BreakLink hängen :(
AW: VBA - Speichern unter
27.03.2019 10:24:12
Torsten
Probier noch mal meine letzte Variante
AW: VBA - Speichern unter
27.03.2019 10:24:24
Daniel
Jep, da ist was weggefallen. Gehört so
ThisWorkbook.BreakLink alleLinks(i), xlLinkTypeOLELinks + xlLinkTypeExcelLinks
AW: VBA - Speichern unter
27.03.2019 09:10:48
Kai
Hallo Torsten,
leider ist in der neuen Datei noch die Verbindung zur Query (Daten / Verbindungen) enthalten.
Diese sollen in der neuen Datei nicht mehr vorhanden sein. Grund dafür ist, dass diese Verbindungen
die Datei extrem aufbläht.
Hast Du einen Tipp?
Gruß und Danke
Kai
Anzeige
AW: VBA - Speichern unter
27.03.2019 09:23:40
Torsten
Dann versuch nochmal:

Sub Speichernunter2()
Dim wkbMappe As Workbook
Dim VarPfad As Variant
Dim strOrdner As String
Dim vntBlattName As Variant
Dim WS As Worksheet
Dim Cn As Variant
Application.DisplayAlerts = False
vntBlattName = Array("Sheet1", "Sheet2")
Sheets(vntBlattName).Copy
Set wkbMappe = ActiveWorkbook
Set VarPfad = Application.FileDialog(msoFileDialogSaveAs)
With VarPfad
.Title = "Wählen Sie das Verzeichnis aus"
.ButtonName = "Speichern..."
.InitialFileName = ThisWorkbook.Path & "\" & wkbMappe.Name
If .Show  -1 Then
Exit Sub
End If
strOrdner = .SelectedItems(1)
End With
For Each WS In wkbMappe.Worksheets
WS.Cells.Copy
WS.Range("A1").PasteSpecial Paste:=xlValues
Next WS
Application.CutCopyMode = False
For Each Cn In wkbMappe.Connections
Cn.Delete
Next Cn
For Each WS In wkbMappe.Worksheets
WS.Activate
For Each Cn In ActiveSheet.QueryTables
Cn.Delete
Next Cn
Next WS
wkbMappe.SaveAs strOrdner
wkbMappe.Close
Application.DisplayAlerts = True
End Sub
Hoffe jetzt wars das.
Anzeige
AW: VBA - Speichern unter
27.03.2019 11:15:32
Kai
Hi Torsten,
sorry - er bleibt wieder hängen:
For Each Cn In wkbMappe.Connections
Cn.Delete
Next Cn
bei dem Cn.Delte ....
AW: VBA - Speichern unter
27.03.2019 12:50:30
Torsten
Komisch. Bei mir laeuft es ohne Problem durch
AW: VBA - Speichern unter
29.03.2019 07:58:41
Kai
Hi Torsten, kann ich Dich nochmals nerven?
Komisch ist, dass das VBA nur dann auf einen Fehler läuft, wenn ich Deine "Blätternamen" von "Sheet1", "Sheet2" ändere.
Nenne ich sie laut meinem Namen um, dieser muss auch zwingend erhalten bleiben, dann läuft es.
Sonst bleibt es bei genau diesem CN.Delete Fehler hängen. Bestätige ich mit OK und speichere ist das gewünschte Ergebnis ja da, aber ich möchte, dass es sauber durchläuft.
Hier nochmals das komplette VBA:

Sub SAPerstellen()
Dim wkbMappe As Workbook
Dim VarPfad As Variant
Dim strOrdner As String
Dim vntBlattName As Variant
Dim WS As Worksheet
Dim Cn As Variant
Application.DisplayAlerts = False
vntBlattName = Array("PR Master Header", "PR Master Prepayments", "PR Master Recoveries", "PR  _
Master Accounting", "PR Master Interest")
Sheets(vntBlattName).Copy
Set wkbMappe = ActiveWorkbook
Set VarPfad = Application.FileDialog(msoFileDialogSaveAs)
With VarPfad
.Title = "Wählen Sie das Verzeichnis aus"
.ButtonName = "Speichern..."
.InitialFileName = ThisWorkbook.Path & "\" & wkbMappe.Name
If .Show  -1 Then
Exit Sub
End If
strOrdner = .SelectedItems(1)
End With
For Each WS In wkbMappe.Worksheets
WS.Cells.Copy
WS.Range("A1").PasteSpecial Paste:=xlValues
Next WS
Application.CutCopyMode = False
For Each Cn In wkbMappe.Connections
Cn.Delete
Next Cn
For Each WS In wkbMappe.Worksheets
WS.Activate
For Each Cn In ActiveSheet.QueryTables
Cn.Delete
Next Cn
Next WS
wkbMappe.SaveAs strOrdner
wkbMappe.Close
Application.DisplayAlerts = True
End Sub

Anzeige
AW: VBA - Speichern unter
29.03.2019 08:03:19
Kai
Folgender Fehler kommt, bleibt lt. Debugger bei Cn.Delete hängen....
Laufzeitfehler 5:
Ungültiger Prozesduraufruf oder ungültiges Argument
For Each WS In wkbMappe.Worksheets
WS.Activate
For Each Cn In ActiveSheet.QueryTables
Cn.Delete
Next Cn
AW: VBA - Speichern unter
29.03.2019 09:04:42
Kai
Es scheint hieran zu liegen, entferne ich dies, dann läuft das Makro sauber durch, aber die Datei enhält noch Querys :(
For Each Cn In wkbMappe.Connections
Cn.Delete
Next Cn
AW: VBA - Speichern unter
29.03.2019 09:12:32
Daniel
Hattest du es denn jetzt schon mit der korrigierten anderen Lösung probiert? Ich konnte den Fehler mit den Connections bei mir ebenfalls feststellen, mit der anderen Methode lief er problemlos durch.
Anzeige
AW: VBA - Speichern unter
29.03.2019 09:18:15
Kai
Hi Daniel,
ich komm voll mit den Versionen durcheinander :(
Kannst Du mir Dein VBA nochmals hier reinkopieren und ich übernehme es dann in meine Excel-Mappe!
Sorry für die Umstände :(
VG Kai
AW: VBA - Speichern unter
29.03.2019 09:24:43
Daniel
Über die Forumsansicht solltest du eigentlich ganz gut die verschiedenen Stränge verfolgen können. Aber egal, das war so:
Sub Speichernunter_NEU()
Dim wkbMappe As Workbook
Dim VarPfad As Variant
Dim strOrdner As String
Dim vntBlattName As Variant
Dim WS As Worksheet
Dim alleLinks As Variant
Dim i As Long
Application.DisplayAlerts = False
vntBlattName = Array("PR Master Header", "PR Master Recoveries", "PR Master Prepayments", " _
PR Master Accounting", "PR Master Interest")
Sheets(vntBlattName).Copy
Set wkbMappe = ActiveWorkbook
Set VarPfad = Application.FileDialog(msoFileDialogSaveAs)
With VarPfad
.Title = "W?hlen Sie das Verzeichnis aus"
.ButtonName = "Speichern..."
.InitialFileName = ThisWorkbook.Path & "\" & wkbMappe.Name
If .Show  -1 Then
Exit Sub
End If
strOrdner = .SelectedItems(1)
End With
alleLinks = wkbMappe.LinkSources()
If Not IsEmpty(alleLinks) Then
For i = UBound(alleLinks) To 1 Step -1
ThisWorkbook.BreakLink alleLinks(i), xlLinkTypeOLELinks + xlLinkTypeExcelLinks
Next
End If
wkbMappe.SaveAs strOrdner
wkbMappe.Close
Application.DisplayAlerts = True
End Sub

AW: VBA - Speichern unter
29.03.2019 09:34:50
Kai
Danke, das VBA läuft zwar durch, allerdings wenn ich die neue Datei öffne, kommt ein SIcherheitshinweis "Sicherheitswarnung Externe Datenverbindung wurden deaktiviert".
Somit sind die Verbindungen immer noch da und die Datei hat eine größe von 1 MB, wenn das andere VB läuft, dann sind es nur noch 36kb.
Ich brauche die kleine Datei, da ich diese sonst nicht verarbeiten kann, da meckert SAP
AW: VBA - Speichern unter
29.03.2019 09:44:40
Daniel
Das liegt wohl daran, dass der Code in einen Fehler läuft, der aber wegen DisplayAlerts aus nicht angezeigt wird (immer etwas heikel das generell auszuschalten).
Mein Fehler, weiß nicht warum das bei mir ging. Es muss doch so heißen:
 wkbMappe.BreakLink alleLinks(i), xlLinkTypeExcelLinks
Sprich, auf einen Schlag Excel und OLE Links zu löschen klappt nicht. Versuch noch mal damit bitte.
AW: VBA - Speichern unter
29.03.2019 09:58:43
Kai
mit der Änderung läuft es zwar durch, aber die Arbeitsmappenverbindungen sind immer noch vorhanden und die Datei immer noch 1 MB groß :( - das war es wohl nicht
AW: VBA - Speichern unter
29.03.2019 10:11:51
Daniel
Seufz. Wir wissen ja auch gar nicht, was du da für Links drin hast, alles etwas schwer nachzuvollziehen. Letzter Versuch meinerseits unter diesen Bedingungen:
   alleLinks = wkbMappe.LinkSources()
If Not IsEmpty(alleLinks) Then
For i = UBound(alleLinks) To 1 Step -1
wkbMappe.BreakLink alleLinks(i), xlLinkTypeExcelLinks
wkbMappe.BreakLink alleLinks(i), xlLinkTypeOLELinks
Next i
End If
Nochmal die OLE Links mit reinnehmen. Viel Glück
AW: VBA - Speichern unter
29.03.2019 10:23:21
Kai
läuft zwar durch, die neue Datei behält aber die Verbindungen und die 1MB Grene - habe auch nochmals gegoogelt, vermutlich hat es damit zu tun:
Es ist wohl so eine Abfrage
XlListObjectSourceType-Aufzählung (Excel)
xlSrcModel 4 PowerPivot-Modell
xlSrcQuery 3 Abfrage
Ich weiß aber nicht, wie es es formuliere soll ....
Danke trotzdem für Deine Unterstützung

328 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige