AW: mehrer OptionButtons dynamisch erzeugen?!
14.09.2014 22:26:57
Mullit
Hallo,
mit Formularsteuerelementen könnte man sich etwas bauen:
Für das Einfügen der Bed. Formatierung müsstest Du nochmal klären, bei welcher Opt.-Buttonwahl die Zelle rot werden soll...
Option Explicit
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Sub Sleep Lib "kernel32" ( _
ByVal dwMilliSeconds As Long)
Private lobjCell As Range
Private lvntArray As Variant
Public Function fncOptionBtn(prstrString As String, probjCell As Range) As String
Set lobjCell = probjCell
lvntArray = Split(Expression:=prstrString, Delimiter:=Chr(10), Limit:=-1, Compare:=vbTextCompare)
Call prcStartTimer
End Function
Private Sub prcStartTimer()
SetTimer Application.hWnd, 0&, 1&, AddressOf TimerProc
End Sub
Private Sub prcStopTimer()
KillTimer Application.hWnd, 0&
End Sub
Private Sub TimerProc(ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
On Error Resume Next
Call prcStopTimer
Call prcInsertButton
End Sub
Private Sub prcInsertButton()
Dim lngIndex As Long, lngOptTop As Long, _
lngHeight As Long, lngWidth As Long, _
lngCount As Long, lngOptLeft As Long, _
lngGrpTop As Long, lngColumn As Long
Dim shpShape As Shape
If ActiveSheet.Shapes.Count > 0 Then
For Each shpShape In ActiveSheet.Shapes
With shpShape
If .FormControlType = xlOptionButton Or .FormControlType = xlGroupBox Then _
If .TopLeftCell.Address = lobjCell.Address Then _
.Delete
End With
Next
End If
lngColumn = 5
lngHeight = 20
lngWidth = 20
lobjCell.RowHeight = (Ubound(lvntArray) + 1) * 25 + 5
For lngIndex = 1 To Ubound(lvntArray) + 1
lngColumn = lngColumn + 1
lngGrpTop = lngGrpTop + lngHeight + 5
lngOptLeft = 0
With lobjCell
For lngCount = 1 To 4
lngOptLeft = lngOptLeft + 10
ActiveSheet.OptionButtons.Add(Left:=.Left + lngOptLeft, _
Top:=.Top + 5 + lngOptTop, Width:=lngWidth, Height:=lngHeight).LinkedCell = _
ActiveSheet.Cells(.Row, .Column + lngColumn).Address
Next
ActiveSheet.GroupBoxes.Add(Left:=.Left + 5, _
Top:=.Top + 5 + lngOptTop, Width:=4 * lngWidth, Height:=lngHeight).Caption = vbNullString
End With
lngOptTop = lngOptTop + 25
Next
Set lobjCell = Nothing
End Sub
Public Sub prcInit()
Dim lngIndex As Long
For lngIndex = 1 To 4
ActiveSheet.Cells(2 + lngIndex, 3).FormulaLocal = _
"=fncOptionBtn(SVERWEIS(A" & 2 + lngIndex & ";Tabelle2!A$3:C$7;2;FALSCH);C" & 2 + lngIndex & ")"
DoEvents
Sleep 50&
Next
End Sub
VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel
Code erstellt und getestet in Office 12
Der Aufruf der Funktion in der Zelle geht dann so: