Modul aus Datei1 in Datei2 und Button zuordnen
12.08.2015 13:29:19
André
ich muss die Frage nochmal mittels neuem Thread einbringen.
Ich habe es geschafft eine neue Arbeitsmappe zu erzeugen, Button kopieren, abspeichern und MAKRO zuordnen.
Leider bezeiht sich in der neuen Mappe das Makro mit Button auf die erste/alte Mappe.
Habt ihr da noch eine Idee? Ab dem "Rem Makro zuordnen" ist irgendwas falsch.
Das Makro befindet sich im Modul 5 und heißt "drucken"
hier der Code:
Sub Speichern_unter_neuem_Namen_Typ02_Excel_Makrosheet()
Dim Neuer_Dateiname As String
Dim xlOldSheetscount As Integer
Rem Speicherpfad und Dateiname anfordern
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:="", fileFilter:="Excel- _
Arbeitsmappe (*.xlsm), *.xlsm")
Rem Abbruch wenn Dateiname leer
If Neuer_Dateiname = "Falsch" Then Exit Sub
Rem Anzahl Standardblätter merken
xlOldSheetscount = Application.SheetsInNewWorkbook
Rem Anzahl Standardblätter temporär umstellen
Application.SheetsInNewWorkbook = 1
Rem Gewünschten Inhalt kopieren
Rem ActiveSheet.Shapes.Range(Array("Picture 7")).Select
Rem Selection.Copy
ActiveSheet.Range("A1:AH1210").Copy
Rem Neue Arbeitsmappe einfügen
Workbooks.Add
Rem Bildschirmmeldungen deaktivieren
Application.DisplayAlerts = False
Rem Inhalt einfügen und Arbeitsmappe speichern
With ActiveWorkbook
ActiveSheet.Buttons.Add(269.25, 30.75, 132, 24.75).Select
.Sheets(1).Range("A1").PasteSpecial xlPasteValues
.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
.Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
Rem .Sheets(1).Range("Picture 7").PasteSpecial xlPasteValues
Dim strFileName As String
strFileName = Format(Now, "yyyymmddhhnnss") & ".bas"
ThisWorkbook.VBProject.VBComponents("Modul5").Export strFileName
ActiveWorkbook.VBProject.VBComponents.Import strFileName
Kill strFileName
Rem Neue Arbeitsmappe erstmalig speichern
.SaveAs Filename:=Neuer_Dateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Rem Druckbutton in neuer Arbeitsmappe beschriften
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Characters.Text = "Tagesrapport drucken"
With Selection.Characters(Start:=1, Length:=20).Font
.Name = "Calibri"
.FontStyle = "Standard"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
ActiveWindow.DisplayGridlines = False
End With
Rem Makro zuordnen
Application.Goto Reference:="drucken"
Selection.OnAction = "drucken"
Range("L8").Select
Rem Neue Arebitsmappe speichern und schließen
.SaveAs Filename:=Neuer_Dateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
Rem Bildschirmmeldungen aktivieren
Application.DisplayAlerts = True
Rem Anzahl Standardblätter wiederherstellen
Application.SheetsInNewWorkbook = xlOldSheetscount
End
Sub
Wäre wirklich dankbar für eure Hilfe
Gruß
Andre