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
1268to1272
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
Inhaltsverzeichnis

Arbeitsblatt als Mappe ohne Querbezüge speichern

Arbeitsblatt als Mappe ohne Querbezüge speichern
Carlos
Hi zusammen,
vorab: ich habe leider keinerlei VBA-Erfahrung und versuche mich gerade an einem Makro, welches folgende Funktion ausführen soll:
1. Das speichern eines Arbeitsblattes als neue eigene Exceldatei (Dateiname=Arbeitsblattname+YYMMDD)
2. Die neue Exceldatei soll alle Formelbezüge innerhalb der Datei beibehalten(!) und alle Bezüge zu anderen Arbeitsblättern der alten Datei in Werte umändern.
Aktuell sieht mein laienhafter Versuch so aus:
Option Explicit

Sub CopynKill()
Dim intCount As Integer
Dim varLinks As Variant
On Error GoTo Fin
Application.ScreenUpdating = False
ThisWorkbook.Worksheets(1).Move ' CodeName des Tabellenblattes anpassen
With ActiveWorkbook
varLinks = .LinkSources(xlExcelLinks)
If Not IsEmpty(varLinks) Then
For intCount = 1 To UBound(varLinks)
.BreakLink varLinks(intCount), xlExcelLinks
Next intCount
End If
End With
ActiveSheet.Move Before:=ThisWorkbook.Worksheets(1)
Fin:
Application.ScreenUpdating = True
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
ActiveSheet.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Makro\" & Format(Now, "YYMMDD") & "Name.xlsx"
ThisWorkbook.Close True
End Sub


Problem1: er übernimmt nicht den Namen des Arbeitsblattes als Dateinamen
Problem2: Bezüge in der Originaldatei werden gelöscht, in der neuen Datei sind sie noch vorhanden. Quasi genau verkehrt herum...
Ich danke euch!
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 10:30:44
Case
Hallo, :-)
so:
Option Explicit
Public Sub Main()
Dim intCount As Integer
Dim varLinks As Variant
Dim WBNew As Workbook
Dim strPfad As String
On Error GoTo Fin
Application.ScreenUpdating = False
strPfad = "C:\Temp\" ' Pfad anpassen
strPfad = IIf(Right(strPfad, 1) = "\", strPfad, strPfad & "\")
ThisWorkbook.Worksheets(1).Copy ' Tabellenblattindex ggf. anpassen
Set WBNew = ActiveWorkbook
With WBNew
varLinks = .LinkSources(xlExcelLinks)
If Not IsEmpty(varLinks) Then
For intCount = 1 To UBound(varLinks)
.BreakLink varLinks(intCount), xlExcelLinks
Next intCount
End If
.SaveAs strPfad & WBNew.Worksheets(1).Name & Format(Now, "YYMMDD"), _
IIf(Val(Application.Version) > 11, 51, xlNormal)
.Close False
End With
Fin:
Set WBNew = Nothing
Application.ScreenUpdating = True
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Servus
Case

Anzeige
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 11:01:40
Carlos
Wow, Case. Ich danke dir vielmals. Nachdem ich deinen Code betrachtet habe, hätte ich mich wohl noch lange versuchen können :/
Kann dir kaum sagen wie dankbar ich bin.
Eine letzte Frage: kann der Nutzer des Makros gefragt werden, wo die neue Datei gespeichert werden soll? Das wäre ein geniales i-Tüpfelchen.
Und: welches sind geeignete Bücher/Materialien um mich im Makro-programmieren/VBA fitter zu machen?
Danke!
Carlos
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 11:15:08
Case
Hallo, :-)
so:
Option Explicit
Public Sub Main()
Dim varFilename As Variant
Dim intCount As Integer
Dim varLinks As Variant
Dim WBNew As Workbook
Dim strPfad As String
On Error GoTo Fin
Application.ScreenUpdating = False
strPfad = "C:\Temp\" ' Pfad anpassen
strPfad = IIf(Right(strPfad, 1) = "\", strPfad, strPfad & "\")
ThisWorkbook.Worksheets(1).Copy ' Tabellenblattindex ggf. anpassen
Set WBNew = ActiveWorkbook
With WBNew
varLinks = .LinkSources(xlExcelLinks)
If Not IsEmpty(varLinks) Then
For intCount = 1 To UBound(varLinks)
.BreakLink varLinks(intCount), xlExcelLinks
Next intCount
End If
varFilename = Application.GetSaveAsFilename( _
fileFilter:="Excel Datei (*.xlsx), *.xlsx", _
InitialFileName:=WBNew.Worksheets(1).Name & _
Format(Now, "YYMMDD") & ".xlsx")
If varFilename  False Then _
.SaveAs strPfad & WBNew.Worksheets(1).Name & Format(Now, "YYMMDD"), _
IIf(Val(Application.Version) > 11, 51, xlNormal)
.Close False
End With
Fin:
Set WBNew = Nothing
Application.ScreenUpdating = True
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Zu Buchempfehlungen bzw. VBA lernen schau mal bitte im Archiv - gibt einige Themen dazu.
Servus
Case

Anzeige
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 11:37:29
Carlos
Hi Case, ;)
vielen Dank. Nur tritt ein Fehler auf. Ich werde zwar gefragt, wo ich die Datei speichern möchte, allerdings speichert er sie dann sowieso nur in dem Verzeichnis, dass im Makro festgelegt ist, ab (C:\Temp).
Könntest Du mir da kurz noch helfen? Bzgl. des VBA-Tipps schau ich mal im Archiv. Danke :)
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 12:37:23
Carlos
Alternativ wäre es auch ideal, wenn das Makro die neue Datei in einem Unterordner des Ordners der Originaldatei abspeichern würde (z.b. "Export"). Wenn dieser nicht existiert, sollte er erstellt werden. Ich sehe schon, ich muss mir mal VBA aneignen.
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 14:09:10
Case
Hallo, :-)
klar, dann muss der Speicherpfad und Name angepasst werden: ;-)
Option Explicit
Public Sub Main()
Dim varFilename As Variant
Dim intCount As Integer
Dim varLinks As Variant
Dim WBNew As Workbook
Dim strPfad As String
On Error GoTo Fin
Application.ScreenUpdating = False
strPfad = "C:\Temp\" ' Pfad anpassen
strPfad = IIf(Right(strPfad, 1) = "\", strPfad, strPfad & "\")
ThisWorkbook.Worksheets(1).Copy ' Tabellenblattindex ggf. anpassen
Set WBNew = ActiveWorkbook
With WBNew
varLinks = .LinkSources(xlExcelLinks)
If Not IsEmpty(varLinks) Then
For intCount = 1 To UBound(varLinks)
.BreakLink varLinks(intCount), xlExcelLinks
Next intCount
End If
varFilename = Application.GetSaveAsFilename( _
fileFilter:="Excel Datei (*.xlsx), *.xlsx", _
InitialFileName:=WBNew.Worksheets(1).Name & _
Format(Now, "YYMMDD") & ".xlsx")
If varFilename  False Then _
.SaveAs varFilename, IIf(Val(Application.Version) > 11, 51, xlNormal)
.Close False
End With
Fin:
Set WBNew = Nothing
Application.ScreenUpdating = True
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Servus
Case

Anzeige
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 14:16:22
Case
Hallo, :-)
mit Pfad anlegen (direkt unter dem der Hauptdatei würde es so gehen:
Option Explicit
Private Declare Function MakeSureDirectoryPathExists _
Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Public Sub Main()
Dim intCount As Integer
Dim varLinks As Variant
Dim WBNew As Workbook
Dim strPfad As String
On Error GoTo Fin
Application.ScreenUpdating = False
strPfad = ThisWorkbook.Path & "\" & "Export" ' Pfad anpassen
strPfad = IIf(Right(strPfad, 1) = "\", strPfad, strPfad & "\")
ThisWorkbook.Worksheets(1).Copy ' Tabellenblattindex ggf. anpassen
Set WBNew = ActiveWorkbook
With WBNew
varLinks = .LinkSources(xlExcelLinks)
If Not IsEmpty(varLinks) Then
For intCount = 1 To UBound(varLinks)
.BreakLink varLinks(intCount), xlExcelLinks
Next intCount
End If
MakeSureDirectoryPathExists (strPfad)
.SaveAs strPfad & WBNew.Worksheets(1).Name & Format(Now, "YYMMDD"), _
IIf(Val(Application.Version) > 11, 51, xlNormal)
.Close False
End With
Fin:
Set WBNew = Nothing
Application.ScreenUpdating = True
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Servus
Case

Anzeige
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 14:22:49
Carlos
Case... perfekt. Ich danke dir vielmals für die Hilfe und die geopferte Zeit.
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 14:58:21
Carlos
Eine letzte Frage noch:
Angenommen ich habe nun eine Arbeitsmappe mit 3 Arbeitsblättern (genannt 1,2,3).
Wie erstelle ich auf dem Arbeitsblatt 0 ein Dropdownmenu, in dem ich Arbeitsblatt 1,2,3 anwählen kann (ohne das bisher etwas passiert) und ich anschließend einen Button drücken kann, damit der Code ausgeführt wird und dann das ausgewählte Arbeitsblatt (1,2,3) exportiert wird.
Ich bin subtil überfordert. VBA-Buch ist bestellt :D
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 15:22:20
Case
Hallo, :-)
hier mal eine Beispieldatei:
https://www.herber.de/bbs/user/80660.xls
Datei muss zum testen einmal gespeichert sein (wegen ThisWorkbook.Path).
Servus
Case

Anzeige
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 16:09:52
Carlos
Hey Case,
besten Dank nochmal. Also zunächst: exakt wie in deinem Beispiel soll es funktionieren.
Ich habe jedoch noch nicht exakt verstanden wie ich die Verknüpfungen der Elemente hinbekomme. Dabei habe ich nun die VBA-Codes verglichen und festgestellt, dass folgende Zeilen unterschiedlich sind:
ursprünglich:
ThisWorkbook.Worksheets(1).Copy
jetzt:
ThisWorkbook.Worksheets(Tabelle1.Combobox1.Value). Copy
Kannst du mir vielleicht sukzessive sagen wie ich vorgehen muss um das Dropdown Menü und den Ausführungsbutton mit den Arbeitsblättern und dem Makro verknüpfe?
Ich weiß wie ich unter den Entwicklertools unter den Formularsteuerelementen eine Schaltfläche (Button) und ein Kombinationsfeld einfüge. An der Stelle bleibe ich leider hängen. Mein Dropdownmenü ist leer :(
Anzeige
AW: Arbeitsblatt als Mappe ohne Querbezüge speichern
20.06.2012 19:36:34
Case
Hallo, :-)
nun - ich habe eine ComboBox aus "ActiveX-Steuerelemente" eingefügt - nicht aus "Formularsteuerelemente". ;-)
"Tabelle1" ist der CodeName des Tabellenblattes.
Du kannst eine Tabelle auf 3 Arten ansprechen:
Der Index - bei einer neuen Datei mit drei Tabellenblättern Tabelle1 = Index 1....
Der Name - der bei einer neuen Datei auch "Tabelle1" folgende ist. Das ist der Name den Du unten auf dem Register siehst.
Dann noch der CodeName. Im VBA-Editor siehst Du dann im Projektexplorer (linke Seite) bei einem deutschen Excel und einer neuen Date:
Tabelle1 (Tabelle1)
Wobei der Name vor der Klammer der CodeName ist, der in der Klammer der Name, den Du im Registerblatt siehst und auch dort verändern kannst.
Na ja - merkst Du was? Ohne VBA - Grundkenntnisse kommst Du nicht richtig weiter.
Servus
Case

Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige