10.04.2013

Bilder - Liste in Spalte A - in Kommentar einfügen...

Frage: In einem Tabellenblatt in Spalte A ab Zeile 2 habe ich Dateinamen gelistet (Bilddateien - jpg). Diese sind in einem Unterordner (Ordnername = Images) in welchem die Exceldatei liegt. Alle Bilder sollen als Kommentar in Spalte B eingefügt werden. Ist ein Bild nicht vorhanden - kurzer Hinweis in Spalte B. Wie geht das?
Kurze Notiz: Auf den Bildern ist mein Husky (Hündin) Kira.

In a worksheet in column A from row 2 I have listed filenames (image files - jpg). These are in a subfolder (folder name = Images) where the Excel file is located. All images should be inserted as a comment in Column B. If an image is not available - short note in column B. How does it work?
Short Note: On the pictures is my Husky (Female) Kira.

Hier noch eine Beispieldatei / Here's a sample file:
Bilder - Liste in Spalte A - in Kommentar einfügen...[ZIP 8 MB]

' Variablendeklaration erforderlich
Option Explicit
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : PictureComment
' Author    : Case (Ralf Stolzenburg)
' Date      : 10.04.2013
' Purpose   : Bilder - Liste in Spalte A - alle in Kommentaren einfügen...
'--------------------------------------------------------------------------
Public Sub PictureComment()
    ' Variablendeklaration
    Dim strPathFile As String
    Dim lngLastRow As Long
    Dim objCom As Object
    Dim lngCalc As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
    With Application
        ' Das Bildschirmaktualisierung wird unterbrochen
        .ScreenUpdating = False
        ' Ereignisroutinen werden deaktiviert
        .EnableEvents = False
        ' Auslesen der momentanen Einstellung für die Berechnung
        lngCalc = .Calculation
        ' Setzen der Berechnung auf "Manuell"
        .Calculation = xlCalculationManual
        '  Eingabeaufforderungen und Warnmeldungen unterdrücken
        .DisplayAlerts = False
    End With
    ' Der Code bezieht sich auf ein bestimmtes Objekt
    ' Hier Tabelle1 = der CodeName der Tabelle
    ' Im VBA-Editor der name VOR der Klammer - Tabelle1 (Tabelle1)
    ' im englischen Excel in der Regel Sheet1
    ' Alles was sich auf dieses "With" bezieht
    ' MUSS mit einem Punkt beginnen
    With Tabelle1
        ' Letzte Zeile in Spalte A ermitteln
        lngLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
            .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        ' Ab Zeile 2 bis Ende
        For lngLastRow = 2 To lngLastRow
            ' Wenn die Datei vorhanden ist, dann...
            If Dir$(ThisWorkbook.Path & Application.PathSeparator & _
                    "Images" & Application.PathSeparator & _
                    .Cells(lngLastRow, 1).Value) <> "" Then
                ' Ist schon ein Kommentar in der entsprechenden Zeile
                ' in Spalte B vorhanden, dann lösche ihn
                If Not .Cells(lngLastRow, 2).Comment Is Nothing Then
                    .Cells(lngLastRow, 2).Comment.Delete
                End If
                ' Füge in der entsprechenden Zeile
                ' in Spalte B einen Kommentar hinzu
                .Cells(lngLastRow, 2).AddComment
                ' Variable mit Pfad- und Dateinamen belegen
                strPathFile = ThisWorkbook.Path & Application.PathSeparator & _
                    "Images" & Application.PathSeparator & _
                    .Cells(lngLastRow, 1).Value
                ' Objektvariable mit dem Kommentar belegen
                Set objCom = .Cells(lngLastRow, 2).Comment.Shape
                ' Bild in Kommentar einfügen und Größe ändern
                With objCom
                    .Fill.UserPicture strPathFile
                    .Width = 266
                    .Height = 200
                End With
            Else
                ' Bild wurde nicht gefunden
                .Cells(lngLastRow, 2).Value = "no picture"
            End If
            ' Objektvariable leeren
            Set objCom = Nothing
        Next lngLastRow
    End With
Fin:
    ' Objektvariable leeren
    Set objCom = Nothing
    ' Die Applikation aufwecken
    With Application
        ' Bildschirmaktualisierung wieder einschalten
        .ScreenUpdating = True
        ' Ereignisroutinen werden wieder aktiviert
        .EnableEvents = True
        ' Setzen der Berechnung auf den gemerkten Wert
        .Calculation = lngCalc
        ' Eingabeaufforderungen und Warnmeldungen wieder zulassen
        .DisplayAlerts = True
        ' Abbrechen Ausschneide- bzw. Kopiermodus und entfernen des Laufrahmens
        .CutCopyMode = True
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Formeln auf einer UserForm in einer TextBox darstellen...

Formeln auf einer UserForm in einer TextBox anzeigen. Z. B. "Formula", "FormulaLocal"... und wie muss die Formel in VBA ...