mit VBA Module Programmieren

Hallo Kollegen,
ich möchte mittels AddIn die Ereignisse Workbook_Activate und WorkSheet_Activate programmieren.
Jedes einzeln funktioniert bestens; nur kann ich nicht beide zusammen programmieren lassen.
mein ADD-In hat folgenenden Code
Application.EnableEvents = False
MacWorkbookAktivateEreigniszufügen
MacWorksheetActivateEreigniszufügen
Application.FileDialog(msoFileDialogSaveAs).Execute
Application.EnableEvents = True
die beiden Module sind für einen Schreibschutz in der PHARMA GLP Umgebung

Sub MacWorkbookAktivateEreigniszufügen()
'Fügt in DieseArbeitsmappe des Workbooks ein Macro in Workbook_Activate_Ereignis
Dim x As Variant, x1 As Long, x2 As Long, Anzahl_der_Zeilen As Long, Macrotext As String,    _
_
_
Macrotext2 As String
Dim Macrotext3 As String, Macrotext4 As String, Macrotext5 As String, Macrotext6 As String,  _
_
_
Macrotext7 As String, Macrotext8 As String, Macrotext9 As String
Macrotext = "    If ActiveSheet.Name  " & Chr$(34) & "Arbeitsunterlagen" & Chr$(34) & "    _
_
_
Then"
Macrotext2 = "    Range(Range(" & Chr$(34) & "A1" & Chr$(34) & "), Range(" & Chr$(34) & "E"  _
_
_
& Chr$(34) & "& Ende_der_Befund_Tabelle)).Select"
Macrotext3 = "    UserName = LCase(Environ(" & Chr$(34) & "USERNAME" & Chr$(34) & "))"
Macrotext4 = "    Range(" & Chr$(34) & "A1" & Chr$(34) & ").Select"
Macrotext5 = "    Case " & Chr$(34) & "oliver.breith" & Chr$(34) & ", " & Chr$(34) & "julia. _
_
_
brunner" & Chr$(34) & ", " & Chr$(34) & "renate.ruetsch" & Chr$(34) & ", " & Chr$(34) & "sonja.  _
_
throm" & Chr$(34) & ", " & Chr$(34) & "angelika.hofer" & Chr$(34) & ", " & Chr$(34) & "felix. _
heppeler" & Chr$(34) & ", " & Chr$(34) & "axel.heppeler" & Chr$(34) & ""
Macrotext6 = "    Range(Range(" & Chr$(34) & "A1" & Chr$(34) & "), Range(" & Chr$(34) & " _
D150" & Chr$(34) & ").End(xlUp)).ColorIndex = xlColorIndexAutomatic"
Macrotext7 = "    Range(" & Chr$(34) & "A1:G150" & Chr$(34) & ").Select"
Macrotext8 = "    If Len(rngAktiveZelle)  0 Or rngAktiveZelle  " & Chr$(34) & Chr$(34) & _
_
_
" Then"    ' If Len(rngAktiveZelle) = 0 Or rngAktiveZelle = "" Then
Macrotext9 = "    Range(" & Chr$(34) & "A65536" & Chr$(34) & ").Select"
With ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule
On Error GoTo error_1
x1 = .ProcBodyLine("Workbook_Activate", vbext_pk_Proc)
On Error GoTo 0
Anzahl_der_Zeilen = .CountOfLines
If x1 > 0 Then
x2 = .ProcBodyLine("Workbook_Activate", vbext_pk_Proc)
.DeleteLines 1, Anzahl_der_Zeilen
End If
continue_1:
x1 = .CreateEventProc("Activate", "Workbook")
.InsertLines x1 + 1, "'dieses Activate Makro wurde durch das Add-In per Makro eingefügt" _
_
_
.InsertLines x1 + 2, "    Dim rngAktiveZelle As Range, Ende_der_Befund_Tabelle as  _
String"
.InsertLines x1 + 3, "    Application.ScreenUpdating = False"
.InsertLines x1 + 4, "    On Error Resume Next"
.InsertLines x1 + 5, Macrotext    'If ActiveSheet.Name  "Arbeitsunterlagen" Then
.InsertLines x1 + 6, "    ActiveSheet.Unprotect"
.InsertLines x1 + 7, Macrotext3    'UserName = LCase(Environ("USERNAME"))
.InsertLines x1 + 8, "    Select Case UserName"
.InsertLines x1 + 9, Macrotext5    ' Case "julia.brunner", "renate.ruetsch", "sonja. _
throm", "angelika.hofer", "felix.heppeler", "axel.heppeler
.InsertLines x1 + 10, Macrotext7  ' Range("A1:G150").Select
.InsertLines x1 + 11, "    Selection.Locked = False"
.InsertLines x1 + 12, "    Selection.Font.ColorIndex = xlColorIndexAutomatic"
.InsertLines x1 + 13, Macrotext4    'Range("A1").Select
.InsertLines x1 + 14, "    Case Else"
.InsertLines x1 + 15, Macrotext9 ' Range("A65536").Select
.InsertLines x1 + 16, "    Ende_der_Befund_Tabelle = ActiveCell.End(xlUp).Row"
.InsertLines x1 + 17, Macrotext2    'Range(Range("A1"), Range("D150").End(xlUp)). _
ColorIndex = xlColorIndexAutomatic
.InsertLines x1 + 18, "    For Each rngAktiveZelle In ActiveSheet.UsedRange"
.InsertLines x1 + 19, "    rngAktiveZelle.Select"
.InsertLines x1 + 20, Macrotext8    'If Len(rngAktiveZelle)  0 Or rngAktiveZelle  "" _
_
_
Then
.InsertLines x1 + 21, "    rngAktiveZelle.Select"
.InsertLines x1 + 22, "    rngAktiveZelle.Font.ColorIndex = 5"
.InsertLines x1 + 23, "    rngAktiveZelle.Locked = True"
.InsertLines x1 + 24, "    End If"
.InsertLines x1 + 25, "    Next"
.InsertLines x1 + 26, Macrotext4    'Range("A1").Select
.InsertLines x1 + 27, "    ActiveSheet.Protect"
.InsertLines x1 + 28, "    End Select"
.InsertLines x1 + 29, "    End If"
.InsertLines x1 + 30, "    Application.ScreenUpdating = True"
End With
Exit Sub
error_1:
On Error GoTo 0
GoTo continue_1
End Sub



Sub MacWorksheetActivateEreigniszufügen()

'Fügt in DieseArbeitsmappe des Workbooks ein Macro in Workbook_SheetActivate_Ereignis

Dim x As Variant, x1 As Long, x2 As Long, Anzahl_der_Zeilen As Long, Macrotext As String,  _

Macrotext2 As String

Dim Macrotext3 As String, Macrotext4 As String, Macrotext5 As String, Macrotext6 As String,  _

Macrotext7 As String, Macrotext8 As String, Macrotext9 As String

Macrotext = "    If ActiveSheet.Name  " & Chr$(34) & "Arbeitsunterlagen" & Chr$(34) & "  _

Then"

Macrotext2 = "    Range(Range(" & Chr$(34) & "A1" & Chr$(34) & "), Range(" & Chr$(34) & "E"  _

& Chr$(34) & "& Ende_der_Befund_Tabelle)).Select"

Macrotext3 = "    UserName = LCase(Environ(" & Chr$(34) & "USERNAME" & Chr$(34) & "))"

Macrotext4 = "    Range(" & Chr$(34) & "A1" & Chr$(34) & ").Select"

Macrotext5 = "    Case " & Chr$(34) & "oliver.breith" & Chr$(34) & ", " & Chr$(34) & "julia. _

brunner" & Chr$(34) & ", " & Chr$(34) & "renate.ruetsch" & Chr$(34) & ", " & Chr$(34) & "sonja.throm" & Chr$(34) & ", " & Chr$(34) & "angelika.hofer" & Chr$(34) & ", " & Chr$(34) & "felix.heppeler" & Chr$(34) & ", " & Chr$(34) & "axel.heppeler" & Chr$(34) & ""

Macrotext6 = "    Range(Range(" & Chr$(34) & "A1" & Chr$(34) & "), Range(" & Chr$(34) & " _

D150" & Chr$(34) & ").End(xlUp)).ColorIndex = xlColorIndexAutomatic"

Macrotext7 = "    Range(" & Chr$(34) & "A1:G150" & Chr$(34) & ").Select"

Macrotext8 = "    If Len(rngAktiveZelle)  0 Or rngAktiveZelle  " & Chr$(34) & Chr$(34) & _

" Then"    ' If Len(rngAktiveZelle) = 0 Or rngAktiveZelle = "" Then

Macrotext9 = "    Range(" & Chr$(34) & "A65536" & Chr$(34) & ").Select"

With ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule

On Error GoTo error_1

'x1 = .ProcBodyLine("SheetActivate", vbext_pk_Proc)

x1 = .ProcBodyLine("Workbook_SheetActivate", vbext_pk_Proc)

On Error GoTo 0

Anzahl_der_Zeilen = .CountOfLines

If x1 > 0 Then

x2 = .ProcBodyLine("Workbook_SheetActivate", vbext_pk_Proc)

.DeleteLines 1, Anzahl_der_Zeilen

End If

continue_1:

x1 = .CreateEventProc("SheetActivate", "Workbook")

.InsertLines x1 + 1, "'dieses Activate Makro wurde durch das Add-In per Makro eingefügt" _

.InsertLines x1 + 2, "    Dim rngAktiveZelle As Range, Ende_der_Befund_Tabelle as  _

String"

.InsertLines x1 + 3, "    Application.ScreenUpdating = False"

.InsertLines x1 + 4, "    On Error Resume Next"

.InsertLines x1 + 5, Macrotext    'If ActiveSheet.Name  "Arbeitsunterlagen" Then

.InsertLines x1 + 6, "    ActiveSheet.Unprotect"

.InsertLines x1 + 7, Macrotext3    'UserName = LCase(Environ("USERNAME"))

.InsertLines x1 + 8, "    Select Case UserName"

.InsertLines x1 + 9, Macrotext5    ' Case "julia.brunner", "renate.ruetsch", "sonja. _

throm", "angelika.hofer", "felix.heppeler", "axel.heppeler

.InsertLines x1 + 10, Macrotext7  ' Range("A1:G150").Select

.InsertLines x1 + 11, "    Selection.Locked = False"

.InsertLines x1 + 12, "    Selection.Font.ColorIndex = xlColorIndexAutomatic"

.InsertLines x1 + 13, Macrotext4    'Range("A1").Select

.InsertLines x1 + 14, "    Case Else"

.InsertLines x1 + 15, Macrotext9 ' Range("A65536").Select

.InsertLines x1 + 16, "    Ende_der_Befund_Tabelle = ActiveCell.End(xlUp).Row"

.InsertLines x1 + 17, Macrotext2    'Range(Range("A1"), Range("D150").End(xlUp)). _

ColorIndex = xlColorIndexAutomatic

.InsertLines x1 + 18, "    For Each rngAktiveZelle In ActiveSheet.UsedRange"

.InsertLines x1 + 19, "    rngAktiveZelle.Select"

.InsertLines x1 + 20, Macrotext8    'If Len(rngAktiveZelle)  0 Or rngAktiveZelle  "" _

Then

.InsertLines x1 + 21, "    rngAktiveZelle.Select"

.InsertLines x1 + 22, "    rngAktiveZelle.Font.ColorIndex = 5"

.InsertLines x1 + 23, "    rngAktiveZelle.Locked = True"

.InsertLines x1 + 24, "    End If"

.InsertLines x1 + 25, "    Next"

.InsertLines x1 + 26, Macrotext4    'Range("A1").Select

.InsertLines x1 + 27, "    ActiveSheet.Protect"

.InsertLines x1 + 28, "    End Select"

.InsertLines x1 + 29, "    End If"

.InsertLines x1 + 30, "    Application.ScreenUpdating = True"

End With

Exit Sub

error_1:

On Error GoTo 0

GoTo continue_1

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

...beide zusammen programmieren lassen...", Oliver?
Also — in der Darstellung ist der PgmCode zwar etwas unübersichtlich (liegt an der Natur der Sache und am Forum), scheint aber ok zu sein — so ungefähr mache ich so etwas auch (inkl Generator-Hinweis, sehr schön), allerdings idR ohne Variablen. Die benutze ich für HTML-Text (wenn ich so etwas erzeuge), weil der idR noch nachbehandelt und zusammengestellt wdn muss...
Warum du nun nicht 2 Prozz schreiben kannst...? Das geht, wenn sie nicht von gleicher Art sind bzw nicht in das gleiche Modul geschrieben wdn. Anderenfalls dürfte das .CreateEventProc nicht fkt; aber du kannst auf jeden Fall fragen, ob eine solche Proz schon existiert und dann daraus entsprechend unterschiedl Vorgehensweisen ableiten...
Gruß+schöSo, Luc :-?
PS: Übrigens würde ich nicht soviel Zeug in eine EventProc hineinschreiben, schon gar nicht, wenn sie autogeneriert wird. Das macht alles nur komplizierter. Ein einfacher Verteiler, der dann für die unterschiedl Fälle normale Makros aufruft, ist effektiver und übersichtlicher. Und dann generierst du auch noch etliche, höchstwahrscheinlich überflüssige .Select-Anweisungen. Das ist ja beinahe so, als ob man ein Mikroskop zum Nägeleinschlagen benutzen würde... ;-)

Sub Mac_zufügen With ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule x1 = .CreateEventProc("Activate", "Workbook") .InsertLines x1 + 1, "'dieses Activate Makro wurde durch das Add-In per Makro eingefü _ gt" .InsertLines x1 + 2, "'hier Ihren Code für Workbook_Activate einschreiben" x1 = .CreateEventProc("SheetActivate", "Workbook") .InsertLines x1 + 1, "'dieses Activate Makro wurde durch das Add-In per Makro eingefügt" _ .InsertLines x1 + 2, "'hier Ihren Code für Workbook_ShhetActivate einschreiben" End With End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread