HERBERS Excel-Forum - das Archiv
Bewerten Sie hier bitte das Excel-Portal
Makro aus Excel 2003 geht in Excel 2007 nicht - Bi
Joe

Hallo zusammen,
hab folgendes Mkro:
----------------------------------------------- 
Sub Bilder_einfügen()
Dim Pfad As String, Wiederholungen As Long
On Error Resume Next
Pfad = "I:\Allgemein\Organisationshandbuch\6 Marketing\Bilddatenbank\"
For Wiederholungen = 2 To Range("A65536").End(xlUp).Row
Cells(Wiederholungen, 2).Activate
ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 1) & ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 90
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop 1.75
Next
End 


Sub
Problem:
Makro lief in Excel 2003 bestens - jedes Zeile hatte ihr entsprechendes Bild
In Excel 2007 werden alle Bilder übereinander gestapelt (in Zeile 4 = 1. Zeile der Unterlage)  _
und nicht in die entsprechenden Zeilen eingefügt.
Bitte um Lösungsvorschläge und sag schon jetzt --> Besten Dank
Joe
AW: Makro aus Excel 2003 geht in Excel 2007 nicht - Bi
Josef

Hallo Joe,
ungetestet!
Sub Bilder_einfügen()
  Dim Pfad As String, Wiederholungen As Long
  Dim objShp As Object
  
  Pfad = "I:\Allgemein\Organisationshandbuch\6 Marketing\Bilddatenbank\"
  
  For Wiederholungen = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Dir(Pfad & Cells(Wiederholungen, 1) & ".jpg", vbNormal) <> "" Then
      Set objShp = ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 1) & ".jpg")
      With objShp
        .Top = Cells(Wiederholungen, 2).Top
        .Left = Cells(Wiederholungen, 2).Left
        .LockAspectRatio = msoTrue
        .Height = 90
        .IncrementLeft 0.75
        .IncrementLeft 0.75
        .IncrementTop 1.75
      End With
    End If
  Next
  
  Set objShp = Nothing
End Sub

Gruß Sepp

AW: Makro aus Excel 2003 geht in Excel 2007 nicht - Bi
Joe

Hallo Sepp,
danke für die schnelle Antwort.
Leider erscheint folgende Fehlermeldung:
"Objekt unterstützt diese Eigenschaft oder Methode nicht"
Haben Sie einen Lösungsvorschlag?
Danke
Joe
AW: Makro aus Excel 2003 geht in Excel 2007 nicht - Bi
Josef

Hallo Joe,
so geht's.
Sub Bilder_einfügen()
  Dim Pfad As String, Wiederholungen As Long
  Dim objShp As Object
  
  Pfad = "I:\Allgemein\Organisationshandbuch\6 Marketing\Bilddatenbank\"
  
  For Wiederholungen = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Dir(Pfad & Cells(Wiederholungen, 1) & ".jpg", vbNormal) <> "" Then
      Set objShp = ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 1) & ".jpg")
      With objShp
        .Top = Cells(Wiederholungen, 2).Top
        .Left = Cells(Wiederholungen, 2).Left
        .ShapeRange.LockAspectRatio = msoTrue
        .Height = 90
        .ShapeRange.IncrementLeft 0.75
        .ShapeRange.IncrementLeft 0.75
        .ShapeRange.IncrementTop 1.75
      End With
    End If
  Next
  
  Set objShp = Nothing
End Sub


Gruß Sepp

AW: Makro aus Excel 2003 geht in Excel 2007 nicht - Bi
Joe

Hallo Sepp,
ganz herzlichen Dank für die Antwort.
Jetzt klappt das wunderbar - Sie sind eine große Hilfe!!!!!!
Jetzt gibt es noch 1 Problem.
Einige Bilder ragen rechts zuweit über die Spalte hinaus.
Für mich ist nicht erkennbar, was der Auslöser hierfür ist.
Es ist für mich nur verwunderlich, daß Bilder im gleichen
Format und in gleicher Auflösung unterschiedliche Breiten
haben.
Wichtig für das SOLL ist, daß
a.) die Spaltenbreite
bzw.
b.) die Zeilenhöhe
berücksichtigt wird und sich die Bildgröße poportional an diese
2 Kriterien orientiert und zwar so, daß entweder die Spaltenbreite
voll genutzt wird bzw. die volle Zeilenhöhe - je nach dem was für
das Bild besser ist.
Wenn Sie hier auch noch eine Lösung haben, dann sind Sie für mich
der absolute Crack!!!!
Schon jetzt mein herzlichster Dank
Joe
AW: Makro aus Excel 2003 geht in Excel 2007 nicht - Bi
Josef

Hallo Joe,
hier im Forum wird im Allgemeinen das "Du" gebraucht.
So sollte es klappen.
Sub Bilder_einfügen()
  Dim Pfad As String, Wiederholungen As Long
  Dim objShp As Object
  
  Pfad = "I:\Allgemein\Organisationshandbuch\6 Marketing\Bilddatenbank\"
  
  For Wiederholungen = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Dir(Pfad & Cells(Wiederholungen, 1) & ".jpg", vbNormal) <> "" Then
      Set objShp = ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 1) & ".jpg")
      With objShp.ShapeRange
        .LockAspectRatio = msoTrue
        .Top = Cells(Wiederholungen, 2).Top + 1
        .Left = Cells(Wiederholungen, 2).Left + 1
        .Height = Cells(Wiederholungen, 2).Height - 1
        If .Width > Cells(Wiederholungen, 2).Width - 1 Then .Width = Cells(Wiederholungen, 2).Width - 1
      End With
    End If
  Next
End Sub


Gruß Sepp

AW: Makro aus Excel 2003 geht in Excel 2007 nicht - Bi
Joe

Hallo Sepp,
o.k. - das mit dem DU wußte ich nicht, hab einfach nach meiner Erziehung
verfahren ;-)
Also du wirs jetzt von mir geadelt!!!
A: Lösungen schnell
B: Lösungen exact
C: Lösungen voll funktional
daraus resultierend - ein glücklicher Joe
Vielen Dank und eine schöne Weihnachtszeit sowie einen
guten Rutsch in ein erneutes Exceljahr.
Alles Gute für Dich
Joe