Makro über alle Arbeitsblätter

[floeckle]

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?

Leider bin auch ich absoluter VBA-Neuling. 

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

[Steffl]

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

[floeckle]

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?

[Steffl]

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

[floeckle]

Leider nicht.


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

[Steffl]

Hallo,

sorry, da war/ist das ShapeRange zuviel

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

[floeckle]

Stefan, Du bist der Größte.

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