Hallo,
yup, so gehts:
' **********************************************************************
' Modul: Modul4 Typ: Standardmodul
' **********************************************************************
Option Explicit
Option Private Module
Private Const GC_TAB_NAME As String = "Zubereitung"
Public Sub prcRefreshBoxes(ByVal pvstrBoxChoice As String)
Dim objTextBox As Excel.TextBox
Dim avntZubereitung1() As Variant, avntZubereitung2() As Variant
Dim adblLeft(1) As Double, adblTop(1) As Double
Dim ialngIndex As Long, lngCount As Long
avntZubereitung1 = Array("Textfeld 1", "Textfeld 2")
avntZubereitung2 = Array("Textfeld 3", "Textfeld 4")
With Worksheets("Pizza")
For Each objTextBox In .TextBoxes
For ialngIndex = 0 To 1
With objTextBox
If .Name = avntZubereitung1(ialngIndex) Then
lngCount = lngCount + 1
adblLeft(ialngIndex) = .Left
adblTop(ialngIndex) = .Top
Exit For
End If
End With
Next
If lngCount = 2 Then Exit For
Next
If objTextBox Is Nothing Then
Call MsgBox("TextBoxen mit diesem Namen wurde " & _
"nicht gefunden...", vbExclamation)
Else
Call .TextBoxes(avntZubereitung1).Delete
If pvstrBoxChoice = GC_TAB_NAME & "1" Then
Call prcInsertBoxes(pravntBoxNames1:=avntZubereitung1(), _
pradblLeft:=adblLeft(), pradblTop:=adblTop())
Else
Call prcInsertBoxes(pravntBoxNames1:=avntZubereitung1(), _
pradblLeft:=adblLeft(), pradblTop:=adblTop(), opvavntBoxNames2:=avntZubereitung2())
End If
Set objTextBox = Nothing
End If
End With
End Sub
Private Sub prcInsertBoxes(ByRef pravntBoxNames1() As Variant, _
ByRef pradblLeft() As Double, ByRef pradblTop() As Double, _
Optional ByVal opvavntBoxNames2 As Variant)
Dim avntArray() As Variant
Dim ialngIndex As Long
If IsMissing(opvavntBoxNames2) Then
avntArray() = pravntBoxNames1()
Else
avntArray() = opvavntBoxNames2
End If
Call Worksheets(GC_TAB_NAME).TextBoxes(avntArray()).Copy
Call Worksheets("Pizza").Paste
If TypeOf Selection Is Excel.DrawingObjects Then
With Selection
For ialngIndex = 0 To 1
With .Item(ialngIndex + 1)
.Left = pradblLeft(ialngIndex)
.Top = pradblTop(ialngIndex)
.Name = pravntBoxNames1(ialngIndex)
End With
Next
End With
Else
Call MsgBox("Auswahl konnte nicht bestimmt werden...", vbExclamation)
End If
End Sub
Gruß,
|