AW: x1 = .CreateEventProc("Change", "Worksheet")
05.10.2009 23:14:18
Oliver
hallo Franz,
danke für deine Antwort, aber leider habe ich alle Verweise und den "Zugriff auf das VBA-Projektobjektmodell vertrauen" aktiviert.
warscheinlich liegt mein Problem darin, dass ich den beschriebenen Code aus einem AddIn heraus starte. Komischerweise funktioniert ein anderer Aufruf sehr gut:
Sub clsMakro_in_Workbook_zufügen()
'Fügt in erste Tabelle des Workbooks ein Macro in Activate_Ereignis
Dim x As Variant, x1 As Long, x2 As Long, Anzahl_der_Zeilen As Long, Macrotext As String
Dim Envirotext As String, Benutzertext As String
Macrotext = "Range(" & Chr$(34) & "A1" & Chr$(34) & ").Select"
Envirotext = "UserName = LCase(Environ(" & Chr$(34) & "USERNAME" & Chr$(34) & "))"
Benutzertext = "Case " & 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) & ""
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 Sheetzähler as Integer"
.InsertLines x1 + 3, "Sheetzähler = 1"
.InsertLines x1 + 4, "Application.ScreenUpdating = False"
.InsertLines x1 + 5, "Sheets(1).select"
.InsertLines x1 + 6, "do until Sheetzähler = ActiveWorkbook.Sheets.Count"
.InsertLines x1 + 7, Macrotext '"Range(" & Chr$(34) & "A1" & Chr$(34) & ").Select"
.InsertLines x1 + 8, Envirotext '"UserName = LCase(Environ(" & Chr$(34) & "USERNAME" _
& Chr$(34) & "))"
.InsertLines x1 + 9, "Select Case UserName"
.InsertLines x1 + 10, Benutzertext '"Case " & 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) & ""
.InsertLines x1 + 11, "ActiveSheet.Unprotect"
.InsertLines x1 + 12, "Sheetzähler=Sheetzähler+1"
.InsertLines x1 + 13, "Case Else"
.InsertLines x1 + 14, "ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True"
.InsertLines x1 + 15, "Sheetzähler=Sheetzähler+1"
.InsertLines x1 + 16, "End Select"
.InsertLines x1 + 17, "Sheets(Sheetzähler).select"
.InsertLines x1 + 18, "Loop"
.InsertLines x1 + 19, "Sheets(1).select"
.InsertLines x1 + 20, "Call set_App"
.InsertLines x1 + 21, "Application.ScreenUpdating = true"
End With
Exit Sub
error_1:
On Error GoTo 0
GoTo continue_1
End Sub
Dieses Macro wird an gleicher Stelle geschrieben, wie das zuvor nicht funktionsfähige Worksheet_Change Macro
Vielleicht sollte ich dir einmal meine Programmidee vermitteln.
Die Makros sollen in bestehende Excelauswerteblätter geschrieben werden um den Scheibschutz beim Büropersonal aufzuheben. -->Dieses klappt
Freigegebene Zellen sollen beim Verlassen (wenn Wert eingegeben) geschützt werden, damit nachträglich keine Manipulation mehr möglich ist.
Dieses wollte ich in das Worksheet_Change Ereignis schreiben ---->das klappt aber nicht
Hast du dafür eventuell eine andere Idee? gibt es eine bedingte Formatierung, welche Zellen schützt?
Gruß
Oliver