yo und da ham wir schon den Salat (als Beilage zu den Pizzen...) Formate in den Boxen bis der Arzt kommt, da hilft nur löschen und neu erstellen, Dein Event-Code im Tabellenblatt müsstest Du da auch noch anpassen: also folgender Code in die beiden Module, die Codes von den beiden anderen Schwachmaten kannst dann löschen,
' **********************************************************************
' Modul: Tabelle1(Pizza) Typ: Klassenmodul des Tabellenblattes
' **********************************************************************
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address = "$A$3" Then
Select Case .Value
Case "Napoletana (Original)": Call Pizza1
Case "T.G. Master Dough (Poolish)": Call Pizza2
Case "T.G. Napoletana (Poolish)": Call Pizza3
End Select
ElseIf .Address = "$A$10" Then
Application.ScreenUpdating = False
Call prcRefreshBoxes(pvstrBoxChoice:=.Value)
Call .Select
Application.ScreenUpdating = True
End If
End With
End Sub
' **********************************************************************
' 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
avntZubereitung1 = Array("Textfeld 1", "Textfeld 2")
avntZubereitung2 = Array("Textfeld 3", "Textfeld 4")
For Each objTextBox In Worksheets("Pizza").TextBoxes
For ialngIndex = 0 To 1
With objTextBox
If .Name = avntZubereitung1(ialngIndex) Then
adblLeft(ialngIndex) = .Left
adblTop(ialngIndex) = .Top
Call .Delete
Exit For
End If
End With
Next
If ialngIndex = 1 Then Exit For
Next
If objTextBox Is Nothing Then
Call MsgBox("TextBoxen mit diesem Namen wurde " & _
"nicht gefunden...", vbExclamation)
Else
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 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
With ThisWorkbook
For ialngIndex = 0 To 1
Call .Worksheets(GC_TAB_NAME).TextBoxes(avntArray(ialngIndex)).Copy
Call .Worksheets("Pizza").Paste
If TypeOf Selection Is Excel.TextBox Then
With Selection
.Left = pradblLeft(ialngIndex)
.Top = pradblTop(ialngIndex)
.Name = pravntBoxNames1(ialngIndex)
End With
Else
Call MsgBox("Auswahl konnte nicht bestimmt werden...", vbExclamation)
End If
Next
End With
End Sub
|