Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1696to1700
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

exportiertes Macro öffnet Basisdatei

exportiertes Macro öffnet Basisdatei
25.06.2019 12:22:33
Stefan
Liebe Experten,
ich habe eine .xlsm (Basisdatei) und generiere über ein Macro ein neues Workbook (WB2). Weiters werden mittels dieses Macros Buttons generiert(für die Filter die ich im nächsten Satz erwähne). Die Basisdatei exportiert dabei ein Modul (in dem Filter Macros sind) und übergibt dieses an WB2. WB2 wird dann in einen Ordner gespeichert.
WB2 beinhaltet dann...das exportierte Modul, buttons und Werte aus der Basisliste.
Wenn ich das gespeicherte WB2 aufmache und mit dem buttons die Filter betätige öffnet sich immer die Basisliste zusätzlich. Das verstehe ich nicht.
Wie kann ich das unterdrücken?
Unten der Code der das Modul übergibt und die Buttons macht (und auch die Werte kopiert).
VIELEN DANK IM VORAUS FÜR EURE UNTERSTÜTZUNG!!
LG Stefan
Sub Modul_in_neue_Datei_exportieren()
'Modul1 dieser Mappe in neue Datei exportieren
Dim Pfad As String
'alle Filter rausnehmen
Range("A3:BA3").Select
Selection.AutoFilter
Selection.AutoFilter
Pfad = ThisWorkbook.Path & "\Übergabemodul.bas"
'Modul1 aus dieser Mappe exportieren
Application.VBE.ActiveVBProject.VBComponents("Übergabemodul").Export Pfad
Workbooks.Add
ActiveWorkbook.Worksheets.Add.Name = "SPK Wertpapier-Produktliste"
ActiveWorkbook.Worksheets.Add.Name = "Performance B3V AA Portfolios"
'Modul1 in neue Mappe importieren
With ActiveWorkbook
Application.VBE.ActiveVBProject.VBComponents.Import Pfad
End With
'Kopie von Modul1 löschen
Kill Pfad
Sheets("SPK Wertpapier-Produktliste").Select
Range("c4").Select
ActiveWindow.FreezePanes = True
'buttons 11 Stück mit unterschiedlichen Farben
ActiveSheet.Buttons.Add(10, 6, 80, 15).Select
Selection.Characters.Text = "B2"
Selection.OnAction = "B2_"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 1
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button2
ActiveSheet.Buttons.Add(100, 6, 80, 15).Select
Selection.Characters.Text = "B3F"
Selection.OnAction = "B3F"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 1
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button3
ActiveSheet.Buttons.Add(190, 6, 80, 15).Select
Selection.Characters.Text = "B3V"
Selection.OnAction = "B3V"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 1
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button4
ActiveSheet.Buttons.Add(280, 6, 80, 15).Select
Selection.Characters.Text = "Niederbayern"
Selection.OnAction = "Niederbayern"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 1
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button5
ActiveSheet.Buttons.Add(370, 6, 80, 15).Select
Selection.Characters.Text = "PB / WM"
Selection.OnAction = "pbwm"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 1
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button6
ActiveSheet.Buttons.Add(770, 6, 80, 15).Select
Selection.Characters.Text = "Kaufen"
Selection.OnAction = "Kaufen"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 50
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button7
ActiveSheet.Buttons.Add(860, 6, 80, 15).Select
Selection.Characters.Text = "Akkumulieren"
Selection.OnAction = "Akkumulieren"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 46
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button8
ActiveSheet.Buttons.Add(950, 6, 80, 15).Select
Selection.Characters.Text = "Halten"
Selection.OnAction = "halten"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 45
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button9
ActiveSheet.Buttons.Add(1040, 6, 80, 15).Select
Selection.Characters.Text = "Verkaufen"
Selection.OnAction = "verkaufen"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 3
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button10
ActiveSheet.Buttons.Add(1170, 6, 80, 15).Select
Selection.Characters.Text = "NEU"
Selection.OnAction = "Neu"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 13
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
'button11
ActiveSheet.Buttons.Add(1260, 6, 150, 15).Select
Selection.Characters.Text = "Filter deaktivieren"
Selection.OnAction = "filter_deakt"
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.ColorIndex = 1
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
With Selection
.Placement = xlFreeFloating
.PrintObject = False
End With
Range("a1").Select
'ActiveWorkbook.SaveAs Pfad2 & "\EmpflistAuto.xlsm"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="\\s0270096web.f096.d0270.sd.spardat.at\Groups\INET\htdocs\ _
vupload\Aktive Wertpapier-Produktliste", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
'daten ubertragen
Windows("Aktive Wertpapier-Produktliste_V4_Auto.xlsm").Activate
Sheets("Performance B3V AA Portfolios").Select
Range("a1:cc1000").Select
Selection.Copy
Windows("Aktive Wertpapier-Produktliste.xlsm").Activate
Sheets("Performance B3V AA Portfolios").Select
' Range("a1").PasteSpecial Paste:=xlPasteAll
' Range("a1").PasteSpecial Paste:=8
' Range("a1").PasteSpecial Paste:=xlPasteValues
With Workbooks("Aktive Wertpapier-Produktliste.xlsm").Worksheets("Performance B3V AA  _
Portfolios").Range("A1")
.PasteSpecial Paste:=xlValues       ' Werte
.PasteSpecial Paste:=xlFormats      ' Formate
.PasteSpecial Paste:=8
' .PasteSpecial Paste:=xlPasteAll
End With
Range("a1").Select
ActiveWindow.Zoom = 70
Windows("Aktive Wertpapier-Produktliste_V4_Auto.xlsm").Activate
Sheets("SPK Wertpapier-Produktliste ").Select
Range("a1:cc1000").Select
Selection.Copy
Windows("Aktive Wertpapier-Produktliste.xlsm").Activate
Sheets("SPK Wertpapier-Produktliste").Select
' Range("a1").PasteSpecial Paste:=xlPasteAll
' Range("a1").PasteSpecial Paste:=8
' Range("a1").PasteSpecial Paste:=xlPasteValues
With Workbooks("Aktive Wertpapier-Produktliste.xlsm").Worksheets("SPK Wertpapier- _
Produktliste").Range("A1")
.PasteSpecial Paste:=xlValues       ' Werte
.PasteSpecial Paste:=xlFormats      ' Formate
.PasteSpecial Paste:=8
'.PasteSpecial Paste:=xlPasteAll
End With
Range("A3:BA3").Select
Selection.AutoFilter
ActiveWindow.Zoom = 70
Sheets("SPK Wertpapier-Produktliste").Select
Range("c1").Select
' Archivierung als .PDF
' ActiveWorkbook.Sheets("SPK Wertpapier-Produktliste").ExportAsFixedFormat Type:=xlTypePDF,  _
Filename:= _
' "M:\8TRY\PM_passiv\Product Governance\PAP-Prozess\2019 Aktive Wertpapier-Produktliste\ _
Ab_062019\" & Format(Date, yyyymmdd) & " " & Format(Time, "hhmmss") & "_" & Environ("Username") & "  -  AktiveProduktlisteWP.pdf", Quality:= _
' xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
'OpenAfterPublish:=False
Dim maxz&
maxz = Range("A" & Rows.Count).End(xlUp).Row
'Range("A1:Aj" & maxz).Select
ActiveSheet.PageSetup.PrintArea = "$a$3:$ba$" & maxz
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$3:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$a$3:$ba$" & maxz
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = Environ("Username")
.CenterFooter = "Seite &S  von  &A     "
.RightFooter = Date
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 2
.FitToPagesTall = 23
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"M:\8TRY\PM_passiv\Product Governance\PAP-Prozess\2019 Aktive Wertpapier-Produktliste\ _
Ab_062019\" & Format(Date, yyyymmdd) & " " & Format(Time, "hhmmss") & "_" & Environ("Username") & "  -  AktiveProduktlisteWP.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'archivierung bis hierher
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="\\s0270096web.f096.d0270.sd.spardat.at\Groups\INET\htdocs\ _
vupload\Aktive Wertpapier-Produktliste", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
ActiveWorkbook.Close
Windows("Aktive Wertpapier-Produktliste_V4_Auto.xlsm").Activate
Sheets("SPK Wertpapier-Produktliste ").Select
Range("a1").Select
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: exportiertes Macro öffnet Basisdatei
25.06.2019 12:56:14
mmat
Hallo,
vielleicht wie das Basissheet Bezüge auf andere Tabellen des Basisworkbooks enthält ?
Des weiteren, prüfe mal ob in Daten/Verbindungen irgendwas drin steht.
AW: exportiertes Macro öffnet Basisdatei
25.06.2019 14:01:55
Stefan
Hallo,
Verbindungen hatte ich schon kontrolliert.
weder das Basisexcel noch WB2 haben eine Verbindung.
Ich hatte den Verdacht, daß der export des moduls den bezug irgendwie mitnimmt.
Leider komm ich nicht weiter.
LG Stefan
AW: exportiertes Macro öffnet Basisdatei
25.06.2019 14:48:27
Zwenn
Hallo Stefan,
ich gehe davon aus, dass die Makrobezüge in den Buttons auf die Datei zeigen, von der kopiert wurde. Dann müsstest Du die über onAction anpassen.
Viele Grüße,
Zwenn
Anzeige
AW: exportiertes Macro öffnet Basisdatei
25.06.2019 14:51:31
Zwenn
Sehe grade, dass die Buttons gar nicht kopiert werden. Sorry, ist heiß heute ;-)
AW: exportiertes Macro öffnet Basisdatei
25.06.2019 15:14:20
Luschi
Hallo Stefan,
im Code ist eine Ungenauigkeit:

'Modul1 in neue Mappe importieren
With ActiveWorkbook
Application.VBE.ActiveVBProject.VBComponents.Import Pfad
End With
Hier wird das exportierte Modul wieder in die Originaldatei erneut importiert und erhält den Namen 'Übergabemodul1' und nicht in die neuerstellte Arbeitsmappe; dies macht man so:

With ActiveWorkbook
.VBProject.VBComponents.Import Pfad
End With
Gruß von Luschi
aus klein-Paris
Anzeige
AW: exportiertes Macro öffnet Basisdatei
25.06.2019 15:46:47
Luschi
Hallo Stefan,
noch eine Ungenauigkeit entdeckt. Bei .OnAction muß noch der Dateiname der neu erstellten Arbeitsmappe dazugeschrieben werden, ansonsten nimmt Vba automatisch den Namen der Arbeitsmappe, in der Du das Makro startest; also:
Dim sMakro As String
ActiveWorkbook.SaveAs ...
sMakro = ActiveWorkbook.Name & "!"
und dann bei jedem .OnAction: Selection.OnAction = sMakro & "B3F"
Erst jetzt wird das Makro 'B3F' aus der richtigen Mappe gestartet und es wird nicht die Originalmappe mehr geöffnet, denn bei Dir wurde bisher immer das Makro aus der Originalmappe gestartet!
Überzeugen kann man sich, wenn man das Kontextmenü des Buttons per rechter Maustaste öffnet und 'Makro zuweisen...' auswählt, dann sieht man auch die Bescherung.
Gruß von Luschi
aus klein-Paris
Anzeige
AW: exportiertes Macro öffnet Basisdatei
26.06.2019 08:16:05
Stefan
Guten Morgen allerseits,
erstmal ein herzliches DANKE für eure Unterstützung.
Ein zusätzliches Merci an Luschi. Konnte deine Lösung einerseits verstehen und andererseits 1:1 umsetzen. Funktioniert alles bestens!
LG Stefan
AW: exportiertes Macro öffnet Basisdatei
25.06.2019 16:27:46
snb
Das geht doch einfach so:
Sub M_snb_009()
Sheets.Copy
End Sub

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige