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