HERBERS Excel-Forum - die Beispiele

Thema: Grafiken in Zellkommentaren anzeigen

Home

Gruppe

Grafik

Problem

Es sollen alle Bilddateien des in Zelle B1 genannten Verzeichnisses aufgelistet und die Bilder in einem Zellkommentar angezeigt werden.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: Modul1

Sub PicShow()
   Dim pct As Picture
   Dim cmt As Comment
   Dim arr() As String
   Dim iFile As Integer, iRow As Integer, iCounter As Integer, iPattern As Integer
   Dim iAll As Integer, iCol As Integer
   Dim sPattern As String
   Dim bln As Boolean
   Application.ScreenUpdating = False
   Columns(1).NumberFormat = "@"
   Range("A3").Value = "Datei"
   Range("B3").Value = "Datum"
   Range("C3").Value = "Breite"
   Range("D3").Value = "Höhe"
   With Range("A3:D3")
      .Font.Bold = True
      .Interior.ColorIndex = 1
      .Font.ColorIndex = 2
   End With
   iAll = 1
   sPattern = "*.gif"
   For iPattern = 1 To 2
      With Application.FileSearch
         .LookIn = Range("B1").Value
         .Filename = sPattern
         .Execute
         For iCounter = iAll To .FoundFiles.Count + iAll - 1
            ReDim Preserve arr(1 To 5, 1 To iCounter)
            bln = True
            Set pct = ActiveSheet.Pictures.Insert(.FoundFiles(iCounter - iAll + 1))
            arr(1, iCounter) = .FoundFiles(iCounter - iAll + 1)
            arr(2, iCounter) = Dir(.FoundFiles(iCounter - iAll + 1))
            arr(3, iCounter) = FileDateTime(.FoundFiles(iCounter - iAll + 1))
            arr(4, iCounter) = CInt(pct.Width * 1.33333)
            arr(5, iCounter) = CInt(pct.Height * 1.33333)
            pct.Delete
            For iCol = 2 To 5
               Cells(iCounter + 3, iCol - 1).Value = arr(iCol, iCounter)
            Next iCol
            Set cmt = Cells(iCounter + 3, 1).AddComment
            With cmt.Shape
               .Width = CInt(arr(4, iCounter) / 1.33333)
               .Height = CInt(arr(5, iCounter) / 1.33333)
               With .Line
                  .DashStyle = msoLineSolid
                  .Style = msoLineSingle
                  .Transparency = 0#
                  .Visible = msoTrue
                  .ForeColor.RGB = RGB(0, 0, 0)
                  .BackColor.RGB = RGB(255, 255, 255)
               End With
               With .Fill
                  .Visible = msoTrue
                  .ForeColor.RGB = RGB(255, 255, 255)
                  .BackColor.SchemeColor = 80
                  .Transparency = 0#
                  .UserPicture arr(1, iCounter)
               End With
            End With
         Next iCounter
      End With
      sPattern = "*.jpg"
      iAll = iCounter
   Next iPattern
   If bln = False Then
      Beep
      MsgBox "Es wurden keine Bilddateien gefunden -" & vbLf & _
         "überprüfen Sie die eingetragenen Verzeichnisse!"
   End If
   Columns.AutoFit
   Application.ScreenUpdating = True
End Sub

Beiträge aus dem Excel-Forum zu den Themen Grafik und Grafikimport

Jahresgrafik Grafik - Linie nach unten, Kriterien links
Grafik auf Position bringen Viele Grafiken mit gleicher Größe einfügen
Excel Grafiken nur schwarz/weiss Grafik drucken
Grafik nach Change in Exceltabelle laden Bereich als Grafik speichern
Grafiken kopieren Text und Grafik in Fusszeile
Grafik in der Kopfzeile - OHNE PFADANGABE Grafik, Datenbeschriftung
Linie in einer Grafik ansprechen Grafik positionieren
Linien-Säulen auf zwei Achsen - Grafik Grafik in Zelle einfügen, wie?
mehrere Grafiken aus derselben Pivot Grafik anzeigen - evtl. Reihenfolge ändern?
Grafikobjekt nach Zelleingabe anpassen Grafik in Zellen - Sparklines
Grafik Option Explicit zusweisen Grafik bei Nullen nicht weiterführen
Makro bei Rechtsklick auf Grafik Kontextmenü Grafik
Grafikgröße nach Hyperlink festlegen Grafik Drehmoment Leistung
Grafiken mit Säuledarstellung Dynamische Grafik/Diagramm
Beschriftung bei Bubble-Grafik gestapelte Säulengrafik
Dynamischer Datenbereich bei Grafiken Grafik
Schwellenwert in Excel-Grafik einfügen? wechselnde grafiken abhängig von wert einblenden
Grafik-Spezial Vorschaugrafik
Grafikformat Grafik in Tabelle, abhängig von Zellinhalt
Grafikprogramm über Excel legen Grafik in XLS-Kopfzeile im PPT darstellen
Grafiken aus derselben Pivot Grafik mit selektierten Daten
veränderbare Grafik je nach Datenmenge Formatier. einer Pivot Grafik wird immer Rückges.
Grafik immer aktualisieren mehrere Grafiken aus einer Pivot
verzogene Grafik mit VBA zurücksetzen bestimmte Grafik in Zelle nach löschen
3D-Grafik X-Achsenbeschriftung Grafik beim Öffnen einer Datei