# KLEXY, Makro speichern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
ich habe es geschafft:
Neue Arbeitsmappe 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?
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 dankbar für eure Hilfe
Gruß
Andre

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread