Pers Makro bearbeiten.
16.01.2008 07:24:00
chris
ich suche eine Lösung.habe bis jetzt alleine schon geschafft das mir ein Makro 2 Icons in die Menüleiste einfügt.Und diese dann 2 verschiedene Makros aufruft.
Jetzt möchte ich aber das die beiden Makros (hoch und querformat) in die persönliche Makromappe eingefügt werden die Automatisch beim Excelstart gestartet wird.
Also als ein neues Modul.
Und wenn diese noch nicht vorhanden ist auf dem Computer soll Sie erst neu erstellt werden und dann die beiden Makros eingefügt werden.
Würde mich sehr über eure Hilfe freuen.
Danke
Option Explicit
Public Sub CreateMenueButton()
Dim myCommandBar As CommandBar
Dim myCommandBarButton As CommandBarButton
Set myCommandBar = Application.CommandBars("Worksheet Menu Bar")
'Querformat
Set myCommandBarButton = myCommandBar.Controls.Add(Type:=msoControlButton, _
Before:=myCommandBar.Controls.Count + 1, Temporary:=True)
With myCommandBarButton
.BeginGroup = True
.Caption = "Querformat"
.FaceId = 38
.OnAction = "quer"
.Style = msoButtonIconAndCaption
.TooltipText = "Seite Querformat einrichten"
.Tag = "Quer"
End With
'Hochformat
Set myCommandBarButton = myCommandBar.Controls.Add(Type:=msoControlButton, _
Before:=myCommandBar.Controls.Count + 1, Temporary:=True)
With myCommandBarButton
.BeginGroup = True
.Caption = "Hochformat"
.FaceId = 39
.OnAction = "hoch"
.Style = msoButtonIconAndCaption
.TooltipText = "Seite Hochformat einrichten"
.Tag = "Quer"
End With
Set myCommandBar = Nothing
Set myCommandBarButton = Nothing
Set myCommandBar = Nothing
Set myCommandBarButton = Nothing
End Sub
Public Sub querformat()
Application.ScreenUpdating = False
Cells.Select
ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.PrintArea = Selection.Address
With ActiveSheet.PageSetup
' .LeftHeader = ""
' .CenterHeader = ""
' .RightHeader = ""
.LeftFooter = "&D"
' .CenterFooter = ""
.RightFooter = "&Z&F"
.LeftMargin = Application.InchesToPoints(0.590551181102362)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
' .CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("A1").Select
Application.ScreenUpdating = False
ActiveWindow.SelectedSheets.PrintPreview
End Sub
Public Sub hochformat()
Application.ScreenUpdating = False
Cells.Select
ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.PrintArea = Selection.Address
With ActiveSheet.PageSetup
' .LeftHeader = ""
' .CenterHeader = ""
' .RightHeader = ""
.LeftFooter = "&D"
' .CenterFooter = ""
.RightFooter = "&Z&F"
.LeftMargin = Application.InchesToPoints(0.590551181102362)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
' .PrintQuality = 600
.CenterHorizontally = True
' .CenterVertically = False
.Orientation = xlPortrait
' .Draft = False
' .PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
' .Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
' .PrintErrors = xlPrintErrorsDisplayed
End With
Range("A1").Select
Application.ScreenUpdating = False
ActiveWindow.SelectedSheets.PrintPreview
End Sub