Bild aus jpg-File einfügen und Größe änden

Hallo Forum,
ich möchte mir eine Briefmarken-Fehlliste mit Bild anlegen. Das Bild der jeweiligen Briefmarke habe ich als jpg-File in dem Verzeichnis gespeichert, in dem auch meine Tabelle gespeichert ist. Verbindung zwischen Tabelle und Bild ist die Michel-Nummer der Briefmarke. Die Bilder haben den Namen MI####.jgp, wobei #### die 4-stellige Nummer ist. Das ist alles gegeben.
Ich möchte nun meine noch Bild-lose Tabelle durchsuchen, und prüfen, ob zur entsprechenden Zeile ein Bild vorhanden ist. Ist dies der Fall, soll das Bild in Spalte A der aktuellen Zeile eingefügt werden. Danach ist das Bild noch in der Größe anzupassen. Da manche Briefmarken im Hochformat dargestellt sind, möchte ich zuvor die Größe (Länge, Breite) meines einzufügenden Bildes kennen. Davon abhängig wird dann die Zeilenhöhe bestimmt, wobei es nur 2 Größen in der Tabelle gibt: Querformat-Bilder und Hochformat-Bilder.
Nachdem ich die Zeilenhöhe angepasst habe, soll nun das Bild eingefügt werden. Danach ist das Bild auf 20 bzw. 40 mm Höhe zu bringen. Zum Schluss soll das eingefügte Bild noch das Attribut von Zellposition und -größe abhängig erhalten, um beim Löschen der Zeile ebenfalls gelöscht zu werden.
Ich habe versucht, das Ändern der Größe und das Attribut durch die Aufzeichnung meiner Aktivitäten zu erfassen. Doch im generierten Makro finden sich dazu keine Befehle.
Wer kann mir bei meiner Lösung weiterhelfen?
Gruß
Werner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Werner,
teste mal:

Public Sub Bilder_einfügen()
    Dim lngRow As Long
    Dim objShape As Shape
    Application.ScreenUpdating = False
    With Tabelle1
        For Each objShape In .Shapes
            If objShape.Type = msoPicture Then objShape.Delete
        Next
        For lngRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If Dir$(ThisWorkbook.Path & "\" & .Cells(lngRow, 1).Value & ".jpg") <> vbNullString Then
                Set objShape = .Shapes.AddPicture(Filename:=ThisWorkbook.Path & "\" & .Cells(lngRow, 1).Value & ".jpg", _
                    LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
                With objShape
                    .LockAspectRatio = msoTrue
                    If .Height > .Width Then
                        .Height = Application.CentimetersToPoints(4)
                    Else
                        .Height = Application.CentimetersToPoints(2)
                    End If
                End With
                .Rows(lngRow).RowHeight = objShape.Height
                objShape.Top = .Rows(lngRow).Top
                objShape.Left = .Columns(2).Left
                objShape.Placement = xlMoveAndSize
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Bild aus jpg-File einfügen und Größe änden

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bild aus jpg-File einfügen und Größe änden

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread