Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 18:57:33
17.04.2024 16:56:58
Anzeige
Archiv - Navigation
940to944
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
940to944
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Pers Makro bearbeiten.

Pers Makro bearbeiten.
16.01.2008 07:24:00
chris
Hallo guten morgen VBA Experten,
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


11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pers Makro bearbeiten.
16.01.2008 09:07:09
Rudi
Hallo,
ich würde die Mappe mit den Makros als Addin speichern und dann über den Add-Ins-Manager einbinden.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

AW: Pers Makro bearbeiten.offen
16.01.2008 09:27:00
chris
Das geht in meinem Fall nicht.
Kann jemand die frage anders beantworten.
Danke dir trotzdem für den versuch !

AW: Pers Makro bearbeiten.offen
16.01.2008 09:39:00
Rudi
Hallo,
nun, dann halt nicht.
Ist denn sichergestellt, dass auf allen Rechnern bei denen du das machen willst, der Haken bei 'Zugriff auf Visual-Basic-Projekt vertrauen' drin ist? Sonst kannst du keinen Code per Code erstellen.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Anzeige
AW: Pers Makro bearbeiten.offen
16.01.2008 09:51:18
chris
ja genau das ist das Problem.
Ist es natürlich nicht :(
Aber mit addins kenne ich mich noch nicht so dut aus.
Also wie mann die installiert usw..
Habe jetzt einen code mit dem ich herausbekomme wo die addins installiert sind bereits.
Das habe ich herausfinden wollen weil ich ja meine xls.datei auxch in diesen ordner kopieren lassen will als xla aber auch da könnte ein problem entstehen zum beispiel wenn der user selbst addins eingebunden hat die auf einem anderen laufwerk liegen also der standartaddin Ordner dann würde meine datei auch nicht richtig kopiert werden ..
Gibt es einen Lösung

Anzeige
AW: Pers Makro bearbeiten.offen
16.01.2008 10:19:00
Rudi
Hallo,
das ist recht einfach:

Sub prcInstallAddIn()
Dim myADDIN As AddIn
On Error Resume Next
Set myADDIN = AddIns("test")
On Error GoTo 0
If myADDIN Is Nothing Then
Application.DisplayAlerts = False
AddIns.Add ("p:\test.xla")  'wo liegt das Addin? Pfad anpassen
Application.DisplayAlerts = True
End If
AddIns("test").Installed = True
End Sub


Das Addin kann auf einem beliebigen Netzlaufwerk leigen.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

AW: Pers Makro bearbeiten.offen
16.01.2008 10:39:30
chris
Super.
Vielen Dank !!!
bekomm ich jetzt schon hin !

Anzeige
AW: doch noch nichT :( Rudi bitte noch einmal
16.01.2008 10:56:08
chris
Hallo Rudi,
bekomme es nichtzum laufen :((
ich versuche vergeblich die geöffnete xls.datei zu speichern und als addin zu aktivieren :(
Klappt nicht.

Sub wo_ist_pers_anlegen()
Dim AI As AddIn
Dim Copypfad As String
Dim myADDIN As AddIn
On Error Resume Next
Set myADDIN = AddIns("Ansichten.xla")
On Error GoTo 0
For Each AI In Application.AddIns
If InStr(UCase(AI.Name), "SOLVER") Then
Copypfad = AI.Path
Exit For
Else
End If
Next
If Copypfad = "" Then
On Error Resume Next
Copypfad = Workbooks("PERSONL.XLS").Path
If Copypfad = "" Then
Copypfad = Application.Path
Else
'Speicherpfad für addin zu pers xls hinzufügen
End If
End If
On Error GoTo 0
If Right(Copypfad, Len(Copypfad)) = "\" Then
Else
Copypfad = Copypfad & "\"
End If
'ActiveWorkbook.SaveCopyAs Copypfad & "Ansichten.xla"
'AddIns.Add (Copypfad & "Ansicht_Anpassen.xla")  'wo liegt das Addin? Pfad anpassen
If myADDIN Is Nothing Then
Application.DisplayAlerts = False
AddIns.Add ("C:\Program Files\Microsoft Office\OFFICE11\Library\SOLVER\Ansichten.xla")  ' _
wo liegt das Addin? Pfad anpassen
Application.DisplayAlerts = True
End If
AddIns("test").Installed = True
AddIns.Add ("c:\test.xla"), copyfile:=True
AddIns("MeinAddIn").Installed = True
'AddIns("test.xla").Installed = True
Set a = AddIns("Solver Add-In")
If a.Installed = True Then
MsgBox "The Solver add-in is installed"
Else
MsgBox "The Solver add-in is not installed"
End If
AddIns.Add("test.xla").Installed = True
AddIns("C:\Documents and Settings\byc3ba\Desktop\hoch quer.xla").Installed = True
End Sub


Bitte um weitere Hilfe !

Anzeige
AW: doch noch nichT :( Rudi bitte noch einmal
16.01.2008 11:25:33
chris
iss addin auf true
habe es hinbekommen.
Danke noch einmal !

AW: doch noch nichT :( Rudi bitte noch einmal
16.01.2008 11:43:00
Rudi
Hallo,
schön.
Die Pfadbestimmung kannst du dir sparen. Das weiß Excel selbst, wo die Addins liegen.
Ergo einfach so:

Sub prcInstallAddIn()
Dim myADDIN As AddIn
On Error Resume Next
Set myADDIN = AddIns("Ansichten")
On Error GoTo 0
If myADDIN Is Nothing Then
AddIns.Add ("C:\Program Files\Microsoft Office\OFFICE11\Library\SOLVER\Ansichten.xla"),  _
True
End If
AddIns("Ansichten").Installed = True
End Sub


Wenn das Addin noch nicht im Addin-Manager vorhanden ist, wird es von dem angegebenen Ort (kann auch ein Netzlaufwerk sein) in das Addin-Verzeichnis des Benutzer kopiert und installiert.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Anzeige
AW: doch noch nichT :( Rudi bitte noch einmal
16.01.2008 15:12:52
chris
hallo Rudi,
noch einmal vielen Dank !
Aber ich habe noch ein problem.
Ich habe eine xls datei die ich ausführe dann in den speicherort kopiere in dem die addins liegen.
Dann erstelle ich 2 icons im menü die immer jeweils ein makro aus dem addin starten sollten.
Funktioniert aber nicht weil ich pfad wenn ich auch ansicht bearbeiten gehe im pfad von den Makros der dateinahme der exceldatei steht.
Kannst du mir vielleicht helfen ?
Wäre klasse hast mir auch schon super geholfen.
Vielen Dank und hier noch meine bisherigen codes
'---------------------- Makro modul 1
Option Explicit
Sub install_addIn()
Dim AI As AddIn
Dim Copypfad As String
Dim Newwb As Workbook
'Pfad erstellen wohin addin kopiert wird
For Each AI In Application.AddIns
If InStr(UCase(AI.Name), "SOLVER") Then
Copypfad = AI.Path
Exit For
Else
End If
Next
If Copypfad = "" Then
On Error Resume Next
Copypfad = Workbooks("PERSONL.XLS").Path
If Copypfad = "" Then
Copypfad = Application.Path
Else
'Speicherpfad für addin zu pers xls hinzufügen
End If
End If
On Error GoTo 0
If Right(Copypfad, 1) = "\" Then
Else
Copypfad = Copypfad & "\"
End If
If Dir(Copypfad & "Ansichten.xla") = "" Then
ActiveWorkbook.SaveCopyAs Copypfad & "Ansichten.xla"
Else
'datei vorhanden
End If
Set Newwb = Workbooks.Open(Copypfad & "Ansichten.xla")
On Error Resume Next
Newwb.IsAddin = False
Call CreateMenueButton
Newwb.ActiveSheet.Shapes("Button 1").Delete
Newwb.IsAddin = True
Newwb.Close True
On Error GoTo 0
AddIns.Add(Copypfad & "Ansichten.xla").Installed = True
ThisWorkbook.ChangeFileAccess xlReadOnly
Kill ThisWorkbook.FullName
ThisWorkbook.Close False
End Sub


'------------- Makro modul 2
Option Explicit


Public Sub CreateMenueButton()
Dim myCommandBar As CommandBar
Dim myCommandBarButton As CommandBarButton
Set myCommandBar = Application.CommandBars("Worksheet Menu Bar")
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("Querformat").Delete
Application.CommandBars("Worksheet Menu Bar").Controls("Hochformat").Delete
On Error GoTo 0
'Querformat
Set myCommandBarButton = myCommandBar.Controls.Add(Type:=msoControlButton, _
Before:=myCommandBar.Controls.Count + 1, Temporary:=False)
With myCommandBarButton
.BeginGroup = True
.Caption = "Querformat"
.FaceId = 38
.OnAction = "!querformat"
'   .Style = msoButtonIconAndCaption
'   .TooltipText = "Seite Querformat einrichten"
'   .Tag = "Quer"
End With
'Hochformat
Set myCommandBarButton = myCommandBar.Controls.Add(Type:=msoControlButton, _
Before:=myCommandBar.Controls.Count + 1, Temporary:=False)
With myCommandBarButton
.BeginGroup = True
.Caption = "Hochformat"
.FaceId = 39
.OnAction = "!hochformat"
'.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()
End Sub



Public Sub hochformat()
End Sub


Anzeige
AW: Pers Makro bearbeiten.
16.01.2008 09:40:52
chris
Hallo ich habe mir noch einmal gedanken gemacht.
Vielleicht würde es doch klappen.Ich benötige nur noch die möglcihkeit dies also das Installieren des Addins Automatisch erfolgen zu lassen weil sonst der benutzer vielleicht Probleme bekommt und es nicht schafft.
Also so stele ich mir das vor.
ich habe eine Datei "install.xla"
wenn jemand die datei öffnet wird sie automatisch in das addin verzeichniss kopiert das irgendwo auf c: ist.
und die 2 Icons werden erstellt.
Nur wie mache ich das ?
geht das ?
Danke noch einmal

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige