Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1104to1108
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

mit VBA Code schreiben

mit VBA Code schreiben
Oliver
Hallo zusammen,
ich habe ein Add-In programmiert, welches des in bestehenden Excel-Blättern den VBA-Code (für Zellschutz) hineinscheibt.
Das Problem ist aber, dass ich mit dem Code immer nur ein Ereignis; z.B. Worksheet_activate() schreiben kann. Will ich danach noch z.B. in das Worksheet_SelectionChange etwas hinein schreiben, dann stüzt mit Excel mit der Meldung "Das Object wird vom Client getrennt" ab.
Gibt es eine Möglichkeit mehrere Ereignisse mit VBA hintereinander zu schreiben?
Gruß
Oliver

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: mit VBA Code schreiben
07.10.2009 11:59:27
xr8k2
Hallo Oliver,
kannst du mal einen Code(ausschnitt) posten?
Interessant wäre dabei auch wann der Code geschrieben wird (welches Ereignis bzw. wie ausgelöst?) und wohin er geschrieben wird (aktive Mappe? / atives Blatt? / o. a.?).
Gruß,
xr8k2
AW: mit VBA Code schreiben
07.10.2009 12:33:31
Oliver
Hallo,
ich führe diese beiden Macros hinterheinander aus:
Application.EnableEvents = False
clsMakro_in_Workbook_zufügen
Workbook_SheetActivate
Application.EnableEvents = True
hier die beiden CodeAusschnitte:
beim 2. füge ich bisher nur Text hinzu - noch nicht mal das klappt
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

Sub Makro_in_Workbook_SheetActivate_zufügen()
'Fügt in erste Tabelle des Workbooks ein Macro in Deactivate_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
With ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule
On Error GoTo error_1
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 Workbook_SheetActivate Makro wurde durch das Add-In per  _
Makro eingefügt"
End With
Exit Sub
error_1:
On Error GoTo 0
GoTo continue_1
End Sub

Anzeige
AW: mit VBA Code schreiben
07.10.2009 13:27:58
xr8k2
Hallo Oliver,
ich den Code mal getestet ... bei mir (auch Excel2003) läuft er fehlerfrei durch. Auch hab ich alles mal in ein Addin gepackt und auf eine neu erstellte Arbeitsmappe angewandt ... auch ohne Fehler.
Der Knackpunkt scheint daher an einer anderen Stelle zu liegen ^^
Wann bzw. durch was ausgelöst werden denn die Macros im Addin gestartet?
Gruß,
xr8k2
AW: mit VBA Code schreiben
07.10.2009 13:51:13
Oliver
Die Macros werden aus einer Userform (des AddIn) gestartet.
mit diesem werden aus vorhandene Excelpharmablätter (ich arbeite im Pharmabereich) die altem Vorwerte gelöscht und daraus neue Excelvorlagen erstellt.
Ich zeige dir hier mal die letzte Procedur

Sub SpeichernUnter()
Dim fname As String
Dim strDateiname As String
Dim Verbindung As String
Dim Verbindung2 As String
Dim Modul_vorhanden As Boolean
Dim Datenbank_Modul_vorhanden As Boolean
Dim ClsModul_vorhanden As Boolean
Dim VBKomp As VBComponent
Dim Vorlagendatei As String
With ActiveSheet.PageSetup
.BlackAndWhite = True
End With
If GlattProWPellets = True Then
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True    ' _
Arbeitsblatt schützen
End If
'Modul Datenbank einfügen, falls noch nicht vorhanden
Datenbank_Modul_vorhanden = False
'Modul für Datenübernahme aus Comment einfügen, falls noch nicht vorhanden
Modul_vorhanden = False
'Modul für ClsModul einfügen falls noch nicht vorhanden
ClsModul_vorhanden = False
For Each VBKomp In ActiveWorkbook.VBProject.VBComponents
If VBKomp.Name = "Datenbank" Then Datenbank_Modul_vorhanden = True
If VBKomp.Name = "ModulVorwert" Then Modul_vorhanden = True
If VBKomp.Name = "ClsVorwerte" Then ClsModul_vorhanden = True
Next VBKomp
If Datenbank_Modul_vorhanden = False Then
'################################# noch deaktiviert, bis Modul fertig ################## _
'neues_Modul_einfügen
'####################################################################################### _
End If
If ClsModul_vorhanden = False Then
'################################# noch deaktiviert, bis Modul fertig ################## _
class_Modul_einfügen
'####################################################################################### _
End If
If Modul_vorhanden = False Then
'################################# noch deaktiviert, bis Modul fertig ################## _
Modul_Vorwert_einfügen
'####################################################################################### _
End If
SetReference ("DAO")
SetReference ("Script")
Tabellen_Name = ""
'MsgBox "Achtung wenn diese Meldung angezeigt wird, wurde der Pfad nicht richtig aus das  _
Labor eingestellt !" & Chr$(10) & "Bitte Oliver eine Nachricht geben", vbCritical
fname = ("K:\LABOR\Pharmanalytik sonstige\PROBEN Erfassung\")
'fname = ("C:\0 Pharmanalytik sonstige\PROBEN Erfassung\")    ' Zuhause
Prüfungsart = ""
If Datenerfassung2.OptVollprüfung = True Then
Prüfungsart = "Vollprüfung"
End If
If Datenerfassung2.optTeilprüfung = True Then
Prüfungsart = "Teilprüfung"
End If
If tempProbenbezeichnung = "" Then
tempProbenbezeichnung = "Probe"
End If
If Anzahl_der_Kopien > 0 Then
strDateiname = Right(Bezeichnung, (Len(Bezeichnung) - 7)) & Space(1) &  _
tempProbenbezeichnung & " Probe 1 bis " & Val(Anzahl_der_Kopien + 1)
Else
strDateiname = Right(Bezeichnung, (Len(Bezeichnung) - 7)) & Space(1) &  _
tempProbenbezeichnung
End If
If Len(Dateianhang_Pheur) > 0 And Len(Dateianhang_USP) > 0 Then
Verbindung = "_"
Else
Verbindung = " "
End If
If ((Len(Dateianhang_Pheur) > 0 Or Len(Dateianhang_USP) > 0) And Len(Prüfungsart)) > 0 Then
Verbindung2 = "_"
Else
Verbindung2 = ""
End If
Application.DisplayAlerts = False
If InStr(1, Vorlagendatei, "Probe") > 0 Then
Vorlagendatei = Trim(Mid(strDateiname, InStr(1, strDateiname, " "), InStr(1,  _
strDateiname, "Probe") - InStr(1, strDateiname, " ")))
Else
Vorlagendatei = Trim(Mid(strDateiname, InStr(1, strDateiname, " "), (Len(strDateiname) - _
(InStr(1, strDateiname, " ") - 1))))
End If
'ActiveWorkbook.SaveAs Trim("K:\Labor\Pharmanalytik sonstige\Befunde gedruckt\Vorlagen\" &  _
Vorlagendatei & " " & Dateianhang_Pheur & Verbindung & Dateianhang_USP & Verbindung2 & Prüfungsanhang)
ActiveWorkbook.SaveAs Trim("C:\0 Pharmanalytik sonstige\Befunde gedruckt\Vorlagen\" &  _
Vorlagendatei & " " & Dateianhang_Pheur & Verbindung & Dateianhang_USP & Verbindung2 & Prüfungsanhang)    'zuhause
'Application.DisplayAlerts = True
Tabellen_Name = fname & strDateiname & " " & Dateianhang_Pheur & Verbindung &  _
Dateianhang_USP & Verbindung2 & Prüfungsanhang
Application.FileDialog(msoFileDialogSaveAs).InitialFileName = Trim(fname & strDateiname & "  _
" & Dateianhang_Pheur & Verbindung & Dateianhang_USP & Verbindung2 & Prüfungsanhang)
Application.FileDialog(msoFileDialogSaveAs).Show
'Application.FileDialog(msoFileDialogSaveAs).Execute
'############################ momentan erst noch deaktiviert bis fertig##################### _
'Makro_in_Workbook_zufügen
'########################################################################################### _
Application.EnableEvents = False
clsMakro_in_Workbook_zufügen
'Application.EnableEvents = True
'Sheets(1).Select
With Application.VBE.MainWindow
.Visible = Not .Visible
End With
Application.EnableEvents = False
Makro_in_Workbook_SheetActivate_zufügen
With Application.VBE.MainWindow
.Visible = Not .Visible
End With
Application.FileDialog(msoFileDialogSaveAs).Execute
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox "Bitte überprüfen nochmals, ob alle Vorwerte aus der Exceltabelle automatisch gelö _
scht worden sind." & vbCrLf & _
"Info: diese nicht gelöschen Zeilen bleiben weiss"
End
End Sub

Anzeige
AW: mit VBA Code schreiben
08.10.2009 17:50:14
xr8k2
Hallo Oliver,
also ich raff´s nicht ... ich hab nun mal das Makro von dir hergenommen ... auf den ersten Blick seh ich nichts was deinen Fehler nach dem ersten Sub-Einfügen auslöst. Ich habs dann mal um das bereinigt, wozu mir die entspr. Daten fehlen und getestet mit dem Ergebnis: Prozeduren werden ohne Fehler hintereinander eingefügt.
Alles weitere wird da wohl nur ein rumraten werden ... wenn du magst und es deine Daten zulassen kannst du vielleicht mal das kompl. Addin und ggf. weitere erf. Vorlagendateien hochladen?!
Gruß,
xr8k2

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige