Befindet sich im das Blatt Bilder das gesuchte
Bild nicht, soll stattdessen das Bild mit dem
Namen "KeinBild" eingefügt werden. Das klappt
auch über den on error goto ... beim ersten mal.
Nur erkennt mein Makro beim zweiten Mal den Fehler
nicht und ich erhalte trotzdem einen Laufzeitfehler.
Muß ich den Fehlerwert dann bei "keinbildf" wieder
auf Null setzen ? Oder habe ich mal wieder einen
Knoten im Hirn ?
Herzlichen Dank
R . Schmitt
Sub Einfügenf()
'Application.ScreenUpdating = False
'On Error Resume Next
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Name <> "ComboBox1" And sh.Name <> "Combobox2" Then
sh.Delete
End If
Next sh
i = 0
zurückf:
Do Until Range("f8").Offset(i, 0).Value = "''"
Sheets("Auswertung").Select
Range("f8").Offset(i, 0).Activate
bild = ActiveCell.Value
On Error GoTo keinbildf
Sheets("BILDER").Select
ActiveSheet.Shapes(bild).Select
Selection.Copy
Sheets("AUSWERTUNG").Select
Range("f8").Offset(i, 0).Select
ActiveSheet.Paste
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 173.25
Selection.ShapeRange.Width = 147#
Selection.Top = ActiveCell.Top
Selection.Left = ActiveCell.Left
i = i + 9
Loop
Range("b7").Select
GoTo ende
keinbildf:
Sheets("BILDER").Select
ActiveSheet.Shapes("KeinBild").Select
Selection.Copy
Sheets("AUSWERTUNG").Select
Range("f8").Offset(i, 0).Select
ActiveSheet.Paste
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 173.25
Selection.ShapeRange.Width = 147#
Selection.Top = ActiveCell.Top
Selection.Left = ActiveCell.Left
Selection.Name = ActiveCell.Value
i = i + 9
GoTo zurückf
ende:
End Sub