Leider habe ich keine ganz einfachen...
08.04.2008 05:08:00
Luc:-?
...Bspp, Dirk,
nur 2 recht komplexe Lösungen, die jetzt wohl etwas zu umfangreich wären. Ich werde im Folgenden aber versuchen, dir einige wesentl Ausschnitte aus den Pgmm anzugeben.
Zuerst mal eine Bsp-UDF wie man sie auf der Basis (m)einer vorhandenen speziellen Subroutine für den Aufruf durch eine entsprechende Ereignisprozedur schreiben kann...
Die Beispielfunktion nutzt die von EvalXBox bereitgestellte Globalvariable cxBOX.
1. ValVbVar: Als Argument wird der Name einer globalen Konstanten (bzw Variablen) ü _
bergeben, deren Wert ermittelt werden soll.
Rem © LSrCyWorXxlFXss 2007
Function ValVbVar(ByVal vbVar As String) As Variant
' Application.Volatile -nur bei Bedarf für permanente Neuberechnung
' XudF = "ValVbVar" -Fktname, entfällt b.Benutzung cxStandard ValVbVar
If IsArray(vbVar) Then
ValVbVar = CVErr(2023): cxBOX = ""
ElseIf IsError(cxBOX) Then
ValVbVar = cxBOX: cxBOX = ""
ElseIf cxBOX = "" Then
cxBOX = "exec;;" & vbVar 'nur bei Benutzung cxStdd-Exec-Proz ValVbVarExec, sonst
' cxBOX = "exec;execprozname;" & vbVar -proznameExec o.`Exec´ angeben
ValVbVar = "#1mp!"
ElseIf Left(cxBOX, 4) "exec" Then
ValVbVar = cxBOX: cxBOX = ""
Else: ValVbVar = CVErr(2000): cxBOX = ""
End If
End Function
EvalXBox ist hier der Name der Subroutine, die die Hptarbeit leistet und auch bei mit ec=True parametriertem Aufruf die benötigte Ereignisprozedur (sowie eine für die o.gez. spez UDF benutzte Hilfsprozedur) generiert...
Ausschnitt für Prozedurgenerierung:
If ec Then
Set ws = ActiveWorkbook.ActiveSheet: j = -1
With ActiveWorkbook.VBProject
For Each cp In .VBComponents
If cp.Type = vbext_ct_Document Then j = j + 1
If j = ws.Index Then
With cp.CodeModule
If IsError(.ProcCountLines("Worksheet_Change", vbext_pk_Proc)) Then _
.CreateEventProc "Change", "Worksheet": ec = False
While .Lines(.ProcStartLine("Worksheet_Change", _
vbext_pk_Proc) + pz, 1) "End Sub": pz = pz + 1: Wend
If ec Then
If InStr(.Lines(.ProcStartLine("Worksheet_Change", vbext_pk_Proc), _
pz), "EvalXBox") = 0 Then _
.InsertLines .ProcStartLine("Worksheet_Change", vbext_pk_Proc) + _
pz, _
" Rem --- Line inserted by FXss.EvalXBox on " & Date & " _
---" & vbLf & _
" Rem --- Locate right following line & activate by _
removing ""'""! ---" & _
vbLf & "' If Target.HasArray Or Target.Cells.Count = 1 _
Then " & _
"Call EvalXBox(Target)"
Else: .ReplaceLine .ProcStartLine("Worksheet_Change", vbext_pk_Proc) + _
pz - 1, _
" Rem --- Procedure generated by FXss.EvalXBox on " & Date & _
" ---" & _
vbLf & " If Target.HasArray Or Target.Cells.Count = 1 Then " _
& _
"Call EvalXBox(Target)" & vbLf & " Set Target = Nothing"
End If
End With
End If
If cp.Type = vbext_ct_StdModule And cp.Name = "cxModul" Then _
With cp.CodeModule
If IsError(.ProcCountLines("ValVbVarExec", vbext_pk_Proc)) Then
.InsertLines .CountOfLines + 1, vbLf & "Sub ValVbVarExec()" & _
vbLf & vbTab & "Rem --- Procedure generated by FXss.EvalXBox on _
" & Date & " ---" & _
vbLf & vbTab & "On Error Resume Next" & vbLf & " cxBOX = Chr( _
133)" & _
vbLf & vbTab & "Rem Platzhalter VbVar-Zuweisung" & vbLf & "End _
Sub"
End If
px = True
End With
Exit For
End If
Next cp
Der folg Ausschnitt soll ungefähr andeuten wie die Subroutine auf das durch die UDF ausgelöste Ereignis reagiert. Im Original ist dieser Teil natürlich wesentlich länger, weil je nach dem Inhalt der Globalvariablen cxBOX verschiedene Verfahrensweisen (hier mit Keyword exec) selektiert und als Befehlstextstring in die zur obigen UDF gehörige generierte Rumpfprozedur übertragen wdn. diese wird an entsprechender Stelle mit Run aufgerufen.
Da du das Ganze aber für einen speziellen Zweck benötigst, kannst du hier deine speziellen _
Operationen einfügen. Dazu kann auch ein Ausdehnen einer Markierung und das Übertragen einer Formel nach .FormulaArray dieses Bereichs gehören. Es kommt hier auf eine genaue Überlegung an, was zuerst (beim 1.Auslösen der Subroutine durch die Ereignisprozedur) und was später (beim 2.Auslösen durch .Calculate der ActiveCell passieren soll. Alle anderen möglichen Auslösungen sind zu verhindern!
If cxBOX "" Then _
If .Cells(1) = "#1mp!" Then
GoSub bx
If IsArray(cxBOX) Then _
qi = UBound(cxBOX, 1) * UBound(cxBOX, 2) - 1
ReDim xy(qi): i = 0
For Each xb In cxBOX
xy(i) = xb: i = i + 1
Next xb
cxBOX = xy: .Calculate: GoTo ex
End If
If xba = 0 And .Cells(1) = "#1mp!" Then .Calculate
ElseIf .Cells(1) "" Then
GoSub bx
End If
End If
Übrigens ist die eigentliche Aufgabe der Bsp-UDF, Variablenwerte aus VBA auszulesen; bspw auch die von xl- und vbKonstanten.
Vielleicht hilft dir das ja etwas weiter. Das Ausdehnen einer Zellmarkierung auf den exakt ermittelten Bereich einer einzufügenden Matrix ist hier nicht enthalten, aber auch nicht weiter schwierig. Du musst nur die Anzahl der Zeilen und Spalten sowie die Richtung bestimmen, in der das Einfügen erfolgen soll. Beim Abarbeiten von Feldern geht VBA nach vbStandard vor, bei dem von Bereichen nach den xlEinstellungen. Das kann ein einzufügendes Feld schonmal recht merkwürdig auf Zellen aufteilen. Aber das Problem ist lösbar!
So, na dann viel Spaß beim Probieren... ;-)
Falls es Probleme geben sollte (wie gesagt, das sind nur Ausschnitte, die erst vervollständigt wdn müssen, damit das Ganze fkt) kannst du dich ja noch mal melden. Ich könnte evtl noch den Text meiner Hilfedatei drauflegen, aber der wird dir vermutlich nicht viel weiter helfen. Auch habe ich 2007 auf Clever mal was dazu geschrieben (mit Codeausschnitten). Findest du da sicher noch im Archiv (unter Lucius).
Die ganze Konstruktion hat natürlich etwas andere Aufgaben als du sie hast, aber das Prinzip ist das Gleiche.
Gruß Luc :-?