Adressierung und Identifizierung von Textboxen

01/01/2011 - 22:35 von Franz22 | Report spam
Im Tabellenblatt A habe ich jeweils drei verschiedene Textboxen
diversen Nummern zugeordnet, indem ich die verkleinerte Textbox in der
jeweiligen Zelle platziert habe. Durch ein Auswahlverfahren selektiere
ich bestimmte Nummerngruppen in einem Tabellenblatt B, wobei zwei,
manchmal auch alle drei Textboxen in das Tabellenblatt B übernommen
werden. Die Formatierung der Textboxen „versuche“ ich wie folgt:

For Each Shape In ActiveSheet.Shapes
If Shape.Type = msoTextBox Then
Shape.Select
Selection.ShapeRange.ScaleWidth 30, msoFalse,
msoScaleFromBottomLeft
Selection.ShapeRange.ScaleHeight 14, msoFalse,
msoScaleFromBottomLeft
End If
Next Shape

Der Erfolg ist unvollkommen, weil immer nur eine der zwei bzw. drei
Textboxen richtig formatiert wird.

Der nàchste Schritt zu einer einwandfreien Darstellung wàre, wenn ich
die drei Textboxen im Programm mit einem bestimmten Namen versehen
könnte und dann in dem Formatierungsprogrammteil individuell
ansprechen könnte. Aber die Namensvergabe gelingt mir schon nicht,
geschweige denn eine funktionierende VBA Programmierung. Dann könnte
ich nàmlich eine der Textboxen nicht „BottomLeft“, sondern „TopLeft“
anhàngen...
 

Lesen sie die antworten

#1 Andreas Killer
02/01/2011 - 12:00 | Warnen spam
Am 01.01.2011 22:35, schrieb Franz22:

Die Formatierung der Textboxen „versuche“ ich wie folgt:

For Each Shape In ActiveSheet.Shapes
If Shape.Type = msoTextBox Then
Shape.Select
Selection.ShapeRange.ScaleWidth 30, msoFalse,
msoScaleFromBottomLeft
Selection.ShapeRange.ScaleHeight 14, msoFalse,
msoScaleFromBottomLeft
End If
Next Shape

Der Erfolg ist unvollkommen, weil immer nur eine der zwei bzw. drei
Textboxen richtig formatiert wird.


Hast Du vielleicht Textbox und MSForms.Textbox in der Tabelle?

Lass mal das Makro in einer leeren Tabelle laufen:

Sub Test()
With ActiveSheet.Shapes
Set S = .AddOLEObject("Forms.Textbox.1", Left:0, Top:P, Width: 0, Height:P)
S.OLEFormat.Object.Object.Text = "MSForms.TextBox"
Set S = .AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)
S.TextFrame.Characters.Text = "TextBox"
End With
End Sub

Und kuck Dir die beiden Boxen an, hast Du beide Typen in Deinem Blatt?

Der nàchste Schritt zu einer einwandfreien Darstellung wàre, wenn ich
die drei Textboxen im Programm mit einem bestimmten Namen versehen
könnte und dann in dem Formatierungsprogrammteil individuell
ansprechen könnte. Aber die Namensvergabe gelingt mir schon nicht,
geschweige denn eine funktionierende VBA Programmierung. Dann könnte
ich nàmlich eine der Textboxen nicht „BottomLeft“, sondern „TopLeft“
anhàngen...



Jedes Object hat von Haus aus einen Namen, so auch das Shape. Vielleicht hilft diese Sub zum Umbennen ja schon weiter:

Sub RenameShapes()
Dim NewName As String
Dim S As Shape
For Each S In ActiveSheet.Shapes
'Zellen unter dem Shape selektieren
Range(S.TopLeftCell, S.BottomRightCell).Select
Do
On Error Resume Next
NewName = InputBox("Neuer Name", "Shape umbenennen", S.Name)
If NewName = "" Then Exit Sub
S.Name = NewName
If Err.Number <> 0 Then Beep
Loop Until Err.Number = 0
Next
End Sub

Ich würde beim formatieren der Textboxen jedoch nicht mit ScaleWidth/ScaleHeight arbeiten sondern über
Top/Left/Width/Height die Box positionieren.

Andreas.

Sub Test()
ResizeShape ActiveSheet.Shapes(1), Range("B3:C7")
End Sub

Private Sub ResizeShape(S As Shape, R As Range)
'Resize and move a shape to a range

'Exit if bad input
If S Is Nothing Then Exit Sub
If R Is Nothing Then Exit Sub
'We can move a shape only in it's sheet
If S.Parent.Name <> R.Parent.Name Then Exit Sub

With S
'Set position and size
.Left = R.Left
.Top = R.Top
.Height = R.Height
.Width = R.Width
'Pictures may exceed the range now
If .Height > R.Height Then
.Height = R.Height
'Place in horizontal center
.Left = .Left + (R.Width - .Width) / 2
Else
'Place in vertical center
.Top = .Top + (R.Height - .Height) / 2
End If
End With
End Sub

Ähnliche fragen