VBA: Schleife funktioniert nicht
10.05.2016 12:02:46
Hewad
ich habe ein Problem mit einer Schleife innerhalb der Schleife. Ich habe mehrerer Commandbuttons auf meinem Blatt und möchte, dass die Captions (die Beschreibung der Buttons) von der Liste - von oben nach unten nacheinander - übernommen werden.
Es funktioniert soweit:
1- Im ersten Schritt ermittle ich die ANzahl der Buttons und setze zunächst alle Namen zurück auf leer. funktioniert wunderbar!
2- Dann möchte ich, dass der erste Name auf der Liste aus der entsprechenden Zelle übernommen wird. Das funktioniert auch alles soweit.
Mein Problem ist, dass die Schleife zum nächsten Commandbutton nicht überspringt, sodass der gleiche Button verschiedene Namen von der Liste übernimmt.
Durch die While und Wend Schleife kommt es nicht zum "next P"
Ich würde mich auf jede Hilfe freuen :-)
Vielen Dank im Voraus!
Sub Button_Name()
On Error Resume Next
Dim combut As CommandButton
Dim combut_number As Integer
Dim oleObj_number As Integer
Dim i As Integer
Dim p As Integer
Dim Supname As String
Dim bcontinue As Boolean
combut_number = ActiveSheet.Buttons.Count
Debug.Print varA; combut_number
oleObj_number = ActiveSheet.OLEObjects.Count
Debug.Print varA; oleObj_number
For i = 1 To oleObj_number ' Hier alle Captions gelöscht
combut_Name = ActiveSheet.OLEObjects("CommandButton" & i).Object.Caption
ActiveSheet.OLEObjects("CommandButton" & i).Object.Caption = ""
Next i
For p = 1 To oleObj_number
'erster Treffer auf der Liste in der Zeile 8
i = 8
bcontinue = True
While bcontinue
Supname = ActiveSheet.Cells(i, 2).Value '
If Supname = "" Then
bcontinue = False
Else
For Each v In Array(" / ")
Supname = Replace(Supname, v, " ")
Next
Debug.Print varA; Supname
combut_Name = ActiveSheet.OLEObjects("CommandButton" & p).Object.Caption
Debug.Print varA; combut_Name
If combut_Name = "Get images" Then
Exit Sub
End If
ActiveSheet.OLEObjects("CommandButton" & p).Object.Caption = Supname
i = i + 1
End If
Wend
' hier komme ich leider nicht weiter. ich habe auch versucht next p davor und dahinter zu _
packen, jedoch leider ohne Erfolg!
Next p
End Sub
Anzeige