Jetzt noch einmal eine Frage.
Ich nutze also das Makro von Case. Danke nochmals
Code:
Sub Main()
Dim strPicName As Variant
Dim dblScale As Double
Dim objShape As Shape
On Error Resume Next
ActiveSheet.Shapes("picto").Delete
Err.Clear
On Error GoTo Fin
strPicName = "C:\Temp\Bild1.jpg"
Select Case Right(strPicName, 3)
Case "bmp", "jpg", "tif", "gif", "bmp"
Application.ScreenUpdating = False
With Cells(3, 3)
Set objShape = ActiveSheet.Shapes.AddPicture( _
strPicName, msoFalse, msoTrue, .Left, .Top, -1, -1)
objShape.Top = .Top + 1
objShape.Left = .Left + 1
dblScale = WorksheetFunction.Min(.Width / objShape.Width, .Height / objShape.Height)
objShape.Height = objShape.Height * dblScale
objShape.Name = "picto"
End With
Case Else
MsgBox "Sie haben kein gültiges Bild ausgewählt"
End Select
Fin:
Set objShape = Nothing
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Jetzt gibt es aber 9 Piktogramme(Bilder), die ich in mein Tabellenblatt kopieren könnte. max. aber nur 4 gleichzeitig !!
DIe Auswahl etc. ist nicht das Problem, aber wie kann ich das lösen, dass jedes Piktogramm nicht einen festen Platz vorgegeben bekommt, sondern einen dieser 4 Plätze.
Soll heißen ein Pikto.. Platz 1
zwei Pikto Platz 1 und 2 usw..
Ich hoffe das ist verständlich, leider handelt es sich um ein Firmendoku, dass ich nicht wirklich posten kann.
Danke