Clever-Excel-Forum

Hallo,

ich möchte automatisch in eine Datei mit mehreren Arbeitsblättern Fotos einfügen.

In jedem Arbeitsblatt steht eine Fotobezeichnung. Mit dem Makro soll nun automatisch ein Foto mit dieser Fotobezeichnung eingefügt und verkleinert werden.

Mit meinem u. g. Makro klappt das nur immer in einem Tabellenblatt.

Ich hätte aber gerne, dass ich das Marko nur einmal für alle Tabellenblätter ausführen muss und die richtigen Fotos eingestellt werden.

Was muss ich an meinem Marko ändern? Huh

Leider bin auch ich absoluter VBA-Neuling. Angry

Option Explicit

Sub Bilder_einfügen_Größe_ändern()
Dim Pfad As String, Wiederholungen As Long
On Error Resume Next
Pfad = "C:\Users\anja\Pictures\Test\"
For Wiederholungen = 2 To Range("A65536").End(xlUp).Row
Cells(Wiederholungen, 3).Activate
ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 1) & ".jpg").Select
Selection.ShapeRange.Height = 200
Selection.ShapeRange.Width = 100
Selection.ShapeRange.Left = 0
Selection.ShapeRange.Top = 70

Next
End Sub

Gruß

floeckle

Hallo,

mal als Ansatz (das Selektieren ist meist überflüssig aber ich habe das nicht geändert)

Code:
Sub Bilder_einfügen_Größe_ändern()

Dim Pfad As String, Wiederholungen As Long

Dim wksBlatt As Worksheet

On Error Resume Next

Pfad = "C:\Users\anja\Pictures\Test\"

For Each wksBlatt In ThisWorkbook.Worksheets

For Wiederholungen = 2 To wksBlatt.Range("A65536").End(xlUp).Row

wksBlatt.Cells(Wiederholungen, 3).Activate

wksBlatt.Pictures.Insert(Pfad & wksBlatt.Cells(Wiederholungen, 1) & ".jpg").Select

Selection.ShapeRange.Height = 200

Selection.ShapeRange.Width = 100

Selection.ShapeRange.Left = 0

Selection.ShapeRange.Top = 70

Next

Next wksBlatt

End Sub

Hallo Stefan,

das ist schon super!:19:

Jetzt wird zwar in jedem Arbeitsblatt ein Foto eingefügt, jedoch wird das Bild nur in dem ersten Arbeitsblatt
verkleinert dargestellt.
Was muss ich jetzt noch ändern?

Hallo,

und so?

Code:
Sub Bilder_einfügen_Größe_ändern()

   Dim Pfad As String, Wiederholungen As Long

   Dim wksBlatt As Worksheet

   Dim objBild As Object

   On Error Resume Next

   Pfad = "C:\Users\anja\Pictures\Test\"

   For Each wksBlatt In ThisWorkbook.Worksheets

      For Wiederholungen = 2 To wksBlatt.Range("A65536").End(xlUp).Row

         wksBlatt.Cells(Wiederholungen, 3).Activate

         Set objBild = wksBlatt.Pictures.Insert(Pfad & wksBlatt.Cells(Wiederholungen, 1) & ".jpg")

         With objBild.ShapeRange

            .ShapeRange.Height = 200

            .ShapeRange.Width = 100

            .ShapeRange.Left = 0

            .ShapeRange.Top = 70

         End With

      Next

   Next wksBlatt

End Sub

Leider nicht.

Jetzt wird in jedes Arbeitsblatt das Foto in Originalgröße eingefügt, also nicht verkleinert.

Hallo,

sorry, da war/ist das ShapeRange zuviel Confused

Code:
Sub Bilder_einfügen_Größe_ändern()

   Dim Pfad As String, Wiederholungen As Long

   Dim wksBlatt As Worksheet

   Dim objBild As Object

   On Error Resume Next

   Pfad = "C:\Users\anja\Pictures\Test\"

   For Each wksBlatt In ThisWorkbook.Worksheets

      For Wiederholungen = 2 To wksBlatt.Range("A65536").End(xlUp).Row

         wksBlatt.Cells(Wiederholungen, 3).Activate

         Set objBild = wksBlatt.Pictures.Insert(Pfad & wksBlatt.Cells(Wiederholungen, 1) & ".jpg")

         With objBild.ShapeRange

            .Height = 200

            .Width = 100

            .Left = 0

            .Top = 70

         End With

      Next

   Next wksBlatt

End Sub

Stefan, Du bist der Größte.

Es klappt. Vielen, lieben Dank für Deine Hilfe! :18:

floeckle

Steffl

floeckle

Steffl

floeckle

Steffl

floeckle