Schwierige Parameterübergabe an eine Function

[VBATartar]

Hallo Leute,

ich habe hier im Forum einen Code gefunden, den ich super gut gebrauchen könnte.

http://www.clever-excel-forum.de/thread-2271.html

Code:

Option Explicit

Dim lngAZ As Long, lngStart As Long
Dim strCM As String


Private Sub TextBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
lngStart = TextBox1.SelStart
End Sub

Private Sub TextBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
Cancel = True
Effect = 1
strCM = Data.GetText
lngAZ = Len(strCM)
If Shift <> 2 Then
  TextBox1.Text = Application.Replace(TextBox1.Text, lngStart + 1, lngAZ, String(lngAZ, " "))
End If
With TextBox2
  If Len(TextBox1.Text) > Len(.Text) Then
    .Text = .Text & String(Len(TextBox1.Text) - Len(.Text), " ")
  End If
  .Text = Application.Replace(.Text, lngStart + 1, lngAZ, strCM)
End With
End Sub

Nun habe ich folgendes Problem. Alles was unter der TextBox2 steht,  möchte ich auch entsprechend angepaßt für die TextBoxen 3, 4, 5, und 6 auf meiner Userform gebrauchen. Also würde ich diesen Code gerne in eine Function reinpacken, wo er dann von der jeweiligen TextBox aufgerufen wird. Das Problem, dieser Code übersteigt   meine Fähigkeiten und ich weiß weder, wie  die Funktion mit den entprechenden Parameternübergaben  aussieht noch der Funktionsaufruf selbst.

[AlterDresdner]

Hallo VBATartar,
in folgender Weise würde es gehen:

Private Sub TextBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

  Cancel = True

  Effect = 1

  My_Before "Textbox2"

End Sub

Private Sub TextBox3_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

  Cancel = True

  Effect = 1

  My_Before "Textbox3"

End Sub

Function My_Before(BoxString)

  strCM = Data.GetText

  lngAZ = Len(strCM)

  If Shift <> 2 Then

    TextBox1.Text = Application.Replace(TextBox1.Text, lngStart + 1, lngAZ, String(lngAZ, " "))

  End If

  With Me.Controls(BoxString)

    If Len(TextBox1.Text) > Len(.Text) Then

      .Text = .Text & String(Len(TextBox1.Text) - Len(.Text), " ")

    End If

    .Text = Application.Replace(.Text, lngStart + 1, lngAZ, strCM)

  End With

End Function

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Wenn Du die beiden zeilen auch noch in My_Before reinpacken willst, die beiden  Variablen halt als Parameter dazuschreiben.
Gruß der AlteDresdner

[VBATartar]

@Hallo AlteDresdner, zunächst schon mal vielen Dank für deine Hilfe. Aber der Code funktioniert  leider noch nicht richtig.

Derzeit sieht mein Code insgesamt folgendermaßen aus, hinzu kommt noch eine UserForm mit einigen Textboxen drauf (vgl. Initialisierungsprozeßes Userform_Initialize)

Code:

Option Explicit

Dim lngAZ As Long, lngStart As Long
Dim strCM As String
Sub TextBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
lngStart = TextBox1.SelStart
End Sub
Private Sub TextBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
 Cancel = True
 Effect = 1
 My_Before "Textbox2"
End Sub
Private Sub TextBox3_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
 Cancel = True
 Effect = 1
 My_Before "Textbox3"
End Sub
Function My_Before(BoxString)
 
 strCM = Data.GetText
 lngAZ = Len(strCM)
 If Shift <> 2 Then
   TextBox1.Text = Application.Replace(TextBox1.Text, lngStart + 1, lngAZ, String(lngAZ, " "))
 End If
 With Me.Controls(BoxString)
   If Len(TextBox1.Text) > Len(.Text) Then
     .Text = .Text & String(Len(TextBox1.Text) - Len(.Text), " ")
   End If
   .Text = Application.Replace(.Text, lngStart + 1, lngAZ, strCM)
 End With
End Function
Sub UserForm_Initialize()
Dim i As Integer
Application.WindowState = xlMaximized
With Me
.Height = Application.Height
.Width = Application.Width
End With

For i = 1 To 4
Me.Controls("TextBox" & i).Font.Name = "Courier New"
Me.Controls("TextBox" & i).Font.Size = 10
Me.Controls("TextBox" & i).BackStyle = fmBackStyleTransparent
Me.Controls("TextBox" & i).BorderStyle = fmBorderStyleSingle
Me.Controls("TextBox" & i).BackColor = &H8000000F
Me.Controls("TextBox" & i).DragBehavior = fmDragBehaviorEnabled
Me.Controls("TextBox" & i).Left = 0
Me.Controls("TextBox" & i).Height = 20
Me.Controls("TextBox" & i).Top = i * 30 - 20
Me.Controls("TextBox" & i).Width = Application.Width
Me.Controls("TextBox" & i).Visible = True
Next i

TextBox1.Text = "Dies ist das Clever-Excel Forum, da wird Dir gerne geholfen!"
TextBox1.Tag = TextBox1.Text
End Sub

Das Problem ist folgends, ziehe ich den Text aus der TextBox1 rüber in die TextBox2, oder 3 wird wie gewünscht die Funktion aufgerufen und bei

Code:

strCM = Data.GetText

kommt dann die Fehlermeldung Variable nicht definiert.

[AlterDresdner]

Halle VBATartar,
da war ich wohl etwas unaufmerksam. Ergänze

Code:

Function My_Before(BoxString,Data)

und gib den Paramer Data an alle Aufrufe von My_Before mit (z.B. MyBefore "Textbox2",Data). Dann sollte es wohl gehen.
Gruß der AlteDresdner

[Quantum]

Einbindung aller Parameter auch Cancel, Effect und Shift in den Funktionsaufruf für funktionierenden Programmablauf.

Code:

Option Explicit

Dim lngAZ As Long, lngStart As Long
Dim strCM As String

Sub TextBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal shift As Integer)
lngStart = TextBox1.SelStart
End Sub

Private Sub TextBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal shift As Integer)
My_Before "TextBox2", Cancel, Data, Effect, shift
End Sub

Private Sub TextBox3_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal shift As Integer)
My_Before "TextBox3", Cancel, Data, Effect, shift
End Sub

Private Sub TextBox4_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal shift As Integer)
My_Before "TextBox4", Cancel, Data, Effect, shift
End Sub

Private Sub TextBox5_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal shift As Integer)
My_Before "TextBox5", Cancel, Data, Effect, shift
End Sub

Private Sub TextBox6_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal shift As Integer)
My_Before "TextBox6", Cancel, Data, Effect, shift
End Sub

Function My_Before(BoxString, Cancel, Data, Effect, shift)
 Cancel = True
 Effect = 1
 strCM = Data.GetText
 lngAZ = Len(strCM)
 If shift <> 2 Then
   TextBox1.Text = Application.Replace(TextBox1.Text, lngStart + 1, lngAZ, String(lngAZ, " "))
 End If
 With Me.Controls(BoxString)
   If Len(TextBox1.Text) > Len(.Text) Then
     .Text = .Text & String(Len(TextBox1.Text) - Len(.Text), " ")
   End If
   .Text = Application.Replace(.Text, lngStart + 1, lngAZ, strCM)
 End With
End Function

Sub UserForm_Initialize()
Dim i As Integer, vbText As String
Application.WindowState = xlMaximized
With Me
.Height = Application.Height
.Width = Application.Width
End With

For i = 1 To 6
Me.Controls("TextBox" & i).Font.Name = "Courier New"
Me.Controls("TextBox" & i).Font.Size = 10
Me.Controls("TextBox" & i).BackStyle = fmBackStyleTransparent
Me.Controls("TextBox" & i).BorderStyle = fmBorderStyleSingle
Me.Controls("TextBox" & i).BackColor = &H8000000F
Me.Controls("TextBox" & i).DragBehavior = fmDragBehaviorEnabled
Me.Controls("TextBox" & i).Left = 0
Me.Controls("TextBox" & i).Height = 20
Me.Controls("TextBox" & i).Top = i * 30 - 20
Me.Controls("TextBox" & i).Width = Application.Width
Me.Controls("TextBox" & i).Visible = True
Next i
TextBox1.Text = "Dies ist das Clever-Excel Forum, da wird Dir gerne geholfen, ob Anfänger oder fortgeschrittener Programmierer."
TextBox1.SetFocus
End Sub