Gruppierung verschiedener Objekte mittels VBA
24.03.2024 11:38:52
Lance
=Bildurl(A1)
eine Funktion auslöse. Diese Funktion erstellt drei Objekte. Ein Rechteck als Untergrund, ein Bild welches ein QR Code enthält mit den Text aus A1 und eine Textbox mit den Text aus A1. Diese drei Objekte liegen auch schon halbwegs gut positioniert gut übereinander. Nun wollte ich sie gruppieren um sie zu Fixieren. Jedoch schaffe ich es nicht, die drei Objekte variabel zu adressieren um sie zu gruppieren.
ActiveSheet.Shapes.Range(Array("Rectangle 1" , "TextBox 3", "Picture 5")).GroupWie kann ich die höchsten Zahlen am Ende von Rectangle, Textbox und Picture ermitteln?
Hab schon einiges versucht, eine Schleife die, die Objekte zählt (funktioniert nicht weil es nur die aktiven Objekte zählt), habe versucht die Anzahl mit rectangle.count auszulesen etc. Hat jemand dazu eine Idee?
Oder mache ich es mir zu schwer? Eigentlich benötige ich nur ein QR code der den Text aus A1 beim scannen hervorbringt und eine Beschriftung hat die ebenfalls den Text aus A1 wiedergibt.
Hier nochmal der ganze VBA Code, bisher noch unkommentiert und nicht überarbeitet.
Public Function Bildurl(artnum As String) As String
Dim grafiklink As String
grafiklink = "https://chart.googleapis.com/chart?cht=qr&chs=500x500&chl=" & artnum
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Application.Caller.Left, Application.Caller.Top, 75, 85).Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
With ActiveSheet.Pictures.Insert(grafiklink)
.Left = Application.Caller.Left + 2
.Top = Application.Caller.Top
.Height = Application.Caller.Height
.ShapeRange.ZOrder msoBringToFront
.ShapeRange.Height = 71
.ShapeRange.Width = 71
End With
grafiklink = ""
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, Application.Caller.Left, Application.Caller.Top + 68, 75, 14).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = artnum
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).ParagraphFormat. _
FirstLineIndent = 0
Selection.ShapeRange(1).TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignCenter
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
'ActiveSheet.Shapes.Range(Array("Rectangle 1" , "TextBox 3", "Picture 5")).Group
artnum = ""
End Function