Ich habe jetzt unzähle Varianten durch. Ich baue ein Bestellsystem für zwei verschieden Shops. Heißt, bei jedem eingetragenen Artikel in die Bestellliste soll am Ende der Listen-Zeile das jeweilige Logo eingefügt werden, kleiner als das Originalbild, kleiner als die Zeile selbst, für die Übersichtlichkeit in der Liste, mittig ausgerichtet.
Ich habe von Pictures.Insert zu Shapes.AddPicture gewechselt, da ich gelesen habe, dass dies die korrektere Form sei. Jetzt bekomme ich eine Fehlermeldung bei der Festlegung eines Rahmens.
Kann mir jemand meine Fehler aufzeigen? Folgende Fragen stellen sich mir:
- Welchen Variablen-Typ brauche ich für ein eingefügtes Bild?
- Wie kann ich diese Variable dann verwenden, um Größe, Position und Rahmen festzulegen?
Danke sehr!!!!!!
Sub LogoEinfügen(Shop As String, Zeile As Integer, Spalte As Integer)
Dim Breite As Integer
Dim Höhe As Integer
Dim strDatei As String
Dim Logo As Object
Dim ShopFarbe As Long, Rot As Long, Blau As Long
' Farben für die zwei Shops festlegen
Rot = 26316
Blau = 13395456
' Dateinamen je nach Shop auswählen und Shop-Farbe einstellen
If Shop = "ZL" Then
strDatei = "D:\logo1.jpg"
ShopFarbe = Rot
End If
If Shop = "AQ" Then
strDatei = "D:\logo2.jpg"
ShopFarbe = Blau
End If
' Bild einfügen
' Ort festlegen
Dim rg As Range
Set rg = ActiveSheet.Cells(Zeile, Spalte)
' Und einfügen
Set Logo = ActiveSheet.Shapes.AddPicture(strDatei, msoTrue, msoTrue, rg.Left, rg.Top, -1, -1)
Set rg = Nothing
With Logo
.LockAspectRatio = msoFalse ' Verzerrung egal
.Height = Rows(Zeile).RowHeight - 4 ' kleiner als Zeile
.Width = Columns(Spalte).Width - 4 ' schmaler als Spalte
.Top = Cells(Zeile, Spalte).Top + (Cells(Zeile, Spalte).Height - Logo.Height) / 2 ' mittig
.Left = Cells(Zeile, Spalte).Left + (Cells(Zeile, Spalte).Width - Logo.Width) / 2 ' mittig
End With
' Rahmen ums Bild, in der Farbe des Shops
With Logo.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = ShopFarbe
.Weight = 1.5
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
End With
Set Logo = Nothing
' Zeilenhöhe anpassen
' Rows(Zeile).RowHeight = Logo.Height
End Sub
