per Makro jpg einfügen

[Wexel]

Hallo zusammen,

habe folgendes Makro gebastelt, leider wird das jpg nicht an der Richtigen Stelle angezeigt (soll A1)
Kann mir da wer helfen ?
Das Makro stoppt an der Stelle           Dat =...

Sub Bild_einfügen()

Dim Dat As String
Dim Zelle As Range
Dim ScaleA As Double

Set Zelle = Range("A1") 'hier wird das bild eingefügt

Dat = ActiveSheet.Pictures.Insert("G:\explodierende_Bombe.jpg") 'Gefahrenpiktogramm
Select Case Right(Dat, 3)
    Case "bmp", "jpg", "tif", "gif"
            ActiveSheet.Pictures.Insert(Dat).Select
            With Selection.ShapeRange
                .Top = Zelle.Top
                .Left = Zelle.Left
                ScaleA = WorksheetFunction.Min(Zelle.Width / .Width, Zelle.Height / .Height)
                .Height = .Height * ScaleA
            End With
            Selection.Placement = xlMoveAndSize
            Selection.PrintObject = True
    Case Else
        MsgBox "Sie haben kein gültiges Bild ausgewählt"
End Select

        


End Sub


Daanke

[Gast 123]

Hallo

ich habe den Code gerade bei mir getestet, er sollte funktionieren!!  Beim 1.mal stimmte mein Pfad nicht!!  Ist der Pfad so richtig angegeben???

mfg  Gast 123

[Wexel]

Hallo Gast,

das Makro läuft bei mir nur bis zur Stelle Dat =...  dort stoppt der Ablauf, die Zeile wird gelb.
Im Anschluss reagiert Excel nicht mehr, die Tabelle schließt.

Den Pfad, auch das JPG hatte ich schonmal gewechselt, ohne Erfolg

MfG
Wexel

[Crazy Tom]

Hallo

was ist das denn für eine Pfadangabe?

Dat = ActiveSheet.Pictures.Insert("G:\explodierende_Bombe.jpg") 'Gefahrenpiktogramm

was passiert denn wenn du diese Zeile so abänderst

Dat = ("G:\explodierende_Bombe.jpg") 'Gefahrenpiktogramm


MfG Tom

[Wexel]

Hallo,

dann kommt die Fehlermeldung " Die Methode Insert ist für das Objekt Pictures fehlgeschlagen." in Schritt

ActiveSheet.Pictures.Insert(Dat).Select

MfG

[Crazy Tom]

Hallo

so habe ich es erfolgreich getestet

Code:

Sub Bild_einfügen()

Dim Dat As String
Dim Zelle As Range
Dim ScaleA As Double

Set Zelle = Range("A1") 'hier wird das bild eingefügt

Dat = ("D:\Logo.gif") 'Gefahrenpiktogramm
Select Case Right(Dat, 3)
   Case "bmp", "jpg", "tif", "gif"
           ActiveSheet.Pictures.Insert(Dat).Select
           With Selection.ShapeRange
               .Top = Zelle.Top
               .Left = Zelle.Left
               ScaleA = WorksheetFunction.Min(Zelle.Width / .Width, Zelle.Height / .Height)
               .Height = .Height * ScaleA
           End With
           Selection.Placement = xlMoveAndSize
           Selection.PrintObject = True
   Case Else
       MsgBox "Sie haben kein gültiges Bild ausgewählt"
End Select
End Sub

MfG Tom

[Crazy Tom]

Hallo nochmal

was für eine Excelversion benutzt du denn?

Excel 2017?


MfG Tom

[Wexel]

Excel 2016


klappt leider nicht, immernoch die gleiche Fehlermeldung wie unten geschrieben

[Crazy Tom]

Hallo

haste vielleicht noch nen Blattschutz drin?

[Wexel]

nein, auch das nicht, ganz "frische" Datei.