Makros per VBA-Code schreiben

[b***@hotmail.com]

Hallo!

Gibt es eine Möglichkeit, ein Makro in "DieseArbeitsmappe" per
VBA-Code zu erzeugen?

Hintergrund:
Ich möchte in mehrere Arbeitsdateien über ein Makro unter
"DieseArbeitsmappe" ein Makro erzeugen:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Application.Run "GlobalMakro1!AuswahlDruck"
End Sub

Hab mal gelesen dass soetwas über "VBProject.VBComponents" gehen soll,
bin aber nicht weitergekommen.

Besten Dank!
Manfred

[Stefan Onken]

hallo,
teste mal dieses Makro (zunächst mal mit Testdateien):


Sub ProzedurAnlegen()
dateien = Application.GetOpenFilename _
("Excel-Dateien (*.xls), *.xls", MultiSelect:=True)
If IsArray(dateien) Then
For i = 1 To UBound(dateien)
Workbooks.Open dateien(i)
With ActiveWorkbook
Set modul = .VBProject.VBComponents _
("DieseArbeitsmappe").codemodule
modul.insertLines 1, _
"Private Sub Workbook_BeforePrint(Cancel As Boolean)"
modul.insertLines 2, _
"Application.Run ""GlobalMakro1!AuswahlDruck"""
modul.insertLines 3, _
"End Sub"
.Save
.Close
End With
Next
End If
End Sub

Zunächst erscheint der öffnen-Dialog, darin kannst du mehrere Dateien
gleichzeitig markieren (zB mit gedrückter Strg-Taste).
Die Datei(en) werden dann nacheinander abgearbeitet.
Wenn das VBA-Projekt einer Datei geschützt ist, gibt es eine Fehlermeldung.
Das müsste ggfls angepasst werden.

Gruß
stefan

Post by b***@hotmail.com
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Application.Run "GlobalMakro1!AuswahlDruck"
End Sub

[b***@hotmail.com]

Hallo Stefan,

funktioniert (fast) perfekt!!
Eine Frage hätte ich noch:
Einige Dateien kommen aus einer englischen Excel-Version, wo
"DieseArbeitsmappe" "ThisWorkbook" heißt. Auch italienische Versionen
sind dabei.
Gibt es eine Möglichkeit diese anders anzusprechen?

Habe folgendes versucht:
Set modul = .VBProject.VBComponents(1).codemodule

Habe aber festgestellt, dass "DieseArbeitsmappe" nicht immer die
Indexnummer 1 hat...

Besten Dank
Manfred

[stefan onken]

hallo Manfred,

ich bin überrascht, dass DieseArbeitsmappe bzw ThisWorkbook nicht
immer den Index 1 hat. Du könntest eine Fehlerbehandlung einbauen,
etwa so:

arr = Array("ThisWorkbook", "DieseArbeitsmappe", _
"QuestaMappa", "sonstwas")
For x = 1 To UBound(arr)
On Error Resume Next
Set modul = .VBProject.VBComponents _
(arr(x)).codemodule
If Err.Number = 0 Then Exit For
Next

oder über
Application.LanguageSettings. _
LanguageID(msoLanguageIDInstall)

die Sprachversion ermitteln (deutsch ist 1031, englisch 1033,
italienisch weiss ich nicht)
und abhängig davon (zB mit Select Case) eine Variable in
VBComponents() mit Inhalt füllen.


Gruß
stefan

Post by b***@hotmail.com
Hallo Stefan,
funktioniert (fast) perfekt!!
Einige Dateien kommen aus einer englischen Excel-Version, wo
"DieseArbeitsmappe" "ThisWorkbook" heißt. Auch italienische Versionen
sind dabei.
Gibt es eine Möglichkeit diese anders anzusprechen?
Set modul = .VBProject.VBComponents(1).codemodule
Habe aber festgestellt, dass "DieseArbeitsmappe" nicht immer die
Indexnummer 1 hat...
Besten Dank
Manfred

[stefan onken]

sorry, falscher Index:
statt
For x = 1 To UBound(arr) muss es
For x = 0 To UBound(arr) heissen.

stefan

Post by stefan onken
hallo Manfred,
ich bin überrascht, dass DieseArbeitsmappe bzw ThisWorkbook nicht
immer den Index 1 hat. Du könntest eine Fehlerbehandlung einbauen,
arr = Array("ThisWorkbook", "DieseArbeitsmappe", _
"QuestaMappa", "sonstwas")
For x = 1 To UBound(arr)
On Error Resume Next
Set modul = .VBProject.VBComponents _
(arr(x)).codemodule
If Err.Number = 0 Then Exit For
Next
oder über
Application.LanguageSettings. _
LanguageID(msoLanguageIDInstall)
die Sprachversion ermitteln (deutsch ist 1031, englisch 1033,
italienisch weiss ich nicht)
und abhängig davon (zB mit Select Case) eine Variable in
VBComponents() mit Inhalt füllen.
Gruß
stefan