Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1296to1300
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Bilder als Kommentar per Makro einfügen
17.02.2013 22:34:39
Lemmi
Hallo zusammen,
ich habe eine Verzeichnisstruktur mit einigen Unterordner angelegt.
Verzeichnis :z.B. Haus
Unterverzeichnis: z.B Garten, Terasse etc.
Hier habe ich Bilder abgelegt. alle Bilder haben einen Namen. Diesen Namen habe ich als Link in einer Zelle abgelegt. Ich kann also die Bilder bei dem Anselktieren der Zelle aufrufen.
Nun möchte ich , um eine schnelle Voransicht zu kekommen, diese Bilder als Kommentar in die jeweilige Zelle hinzufügen.
Kann das per Makro durchgeführt werden?
Randbedingungen die ich gerne erfüllt haben möchte sind:
Alle Bilder im Kommentarfeld sollen gleich groß werden.(Höhe x Breite)
Alle Bilder sollen möglichst klein sein. z. B 30k
Es sind alle Bilder und dessen Verzeichnisse bekannt! Das Makro soll die Bilderverzeichnisse auslesen um das jeweilige Bild zuordnen.
Es sollen nur die Zellen ab D6 - D1000 berücksichtigt werden.
Vielen Dank schon einaml im Voraus!
Gruß
lemmi

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Variante mit UserForm
18.02.2013 08:46:59
Klaus
Hallo Lemmi,
Theoretisch geht das ja über "Kommentar formatieren, Farben und Linien, Füllfarbe, Fülleffekt, Bild auswählen". Das müsste man jetzt per VBA machen. Leider zeichnet mein 2010-er Makrorekorder von diesem Vorgang gar nichts auf.
Anbei mal meine Alternative (mit einer Userform, um die Vorschaubilder zu zeigen).
https://www.herber.de/bbs/user/83947.xlsm
Ich lass den Beitrag aber offen, vielleicht kennt sich ja jemand mit den VBA-Befehlen für Kommentare aus.
Grüße,
Klaus M.vdT.

AW: Bilder als Kommentar per Makro einfügen
18.02.2013 09:00:08
Klaus
Hallo,
ich nochmal. Mich hat das gewurmt, da habe ich gegoogelt wie man Kommentare mit Bildern füllt. Anbei meine neue Lösung:
Sub MakePreviewPicComments()
Dim sPrev As String
Dim rMake As Range
Dim lRow As Long
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rMake In Range("D6:D" & lRow)
rMake.ClearComments
With rMake.AddComment
.Text ""
.Shape.Fill.UserPicture rMake.Value
End With
Next rMake
End Sub
Grüße,
Klaus M.vdT.

Anzeige
AW: Bilder als Kommentar per Makro einfügen
18.02.2013 12:58:22
Lemmi
Hallo,
wie geschrieben! Ich bekomme auch diese Makro nicht an laufen.
Fehlermeldung:
Die angegebene Datei wurde nicht gefunden!
Laufzeitfehler 2147024809
Gruß
Lemmi

AW: Bilder als Kommentar per Makro einfügen
18.02.2013 13:19:16
Klaus
Hi,
Die angegebene Datei wurde nicht gefunden!
Dann zeig uns doch bitte mal, was in deinen D6 bis D10 steht ... (D6 bis D1000 tut nicht Not)
Ich hatte zum testen folgendes in die Zellen geschrieben:
D6= C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\blue hills.jpg
D7= C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\sunset.jpg
und das hat geklappt. Wenn du die Fehlermeldung "Datei nicht gefunden" bekommst, vermute ich die Datei existiert nicht? Das liegt warscheinlich an einem Tippfehler, oder die Dateiendung fehlt, oder ein \ ist ein / oder warum auch immer die Pfadangabe falsch sein könnte. Vielleicht ist auch deine Angabe unrichtig, und in D6 steht gar keine Pfadangabe zum Bild sondern eine Überschrift?
Mein Makro hat keinerlei Fehlerbehandlung. Man könnte zB, wenn eine Datei nicht gefunden wurde, "Pfad falsch" in den Kommentar schreiben statt das Makro abzubrechen.
Grüße,
Klaus M.vdT.

Anzeige
AW: Bilder als Kommentar per Makro einfügen
18.02.2013 21:03:27
Lemmi
Hallo,
dein makro scheint zu laufen, aber nur wenn der vollständige Hyperlink-Name+ Pfad zu sehen ist!
d. h.
Wenn
D6= C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\blue hills.jpg
D7= C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\sunset.jpg
ist alles o.k.
wenn der Name jedoch nur noch
D6= blue hills.jpg
D7= sunset.jpg
heißt, gibt es den Laufzeitfehler!
....also müsste das Makro "nur" dem Link- Pfad folgen!
Ich habe alle Bilder nur mit Namen versehen und kann diese mir einem Add-in in Excel einlesen.
Es wäre für mich sehr viel arbeit dies zu ändern.
Gruß
Lemmi

Anzeige
AW: Bilder als Kommentar per Makro einfügen
19.02.2013 07:25:14
Klaus
Hallo Lemmi,
Diesen Namen habe ich als Link in einer Zelle abgelegt. Ich kann also die Bilder bei dem Anselktieren der Zelle aufrufen.
Daraus habe ich geschlossen, dass der gesamte Pfadname vorhanden ist. Du kannst jetzt entweder:
den gesamten Pfadnamen jeweils vorne an die Bildernamen dranflicken ODER
mir mitteilen, WO der Pfadname steht. Wenn der Pfad zB IMMER C:\meineBilder\ ist, kann man den auch direkt in den Code schreiben. Das sähe dann so aus:
Sub MakePreviewPicComments()
Dim sPrev As String
Dim rMake As Range
Dim lRow As Long
Dim sPath as String
sPath = "C:\MeineBilder\" 'anpassen!!!
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rMake In Range("D6:D" & lRow)
rMake.ClearComments
With rMake.AddComment
.Text ""
.Shape.Fill.UserPicture sPath & rMake.Value
End With
Next rMake
End Sub
Oder es könnte natürlich sein, dass die Pfadangabe eine Spalte links von der Datei steht (also in C6:C1000). Dann sähe es so aus:
Sub MakePreviewPicComments()
Dim sPrev As String
Dim rMake As Range
Dim lRow As Long
Dim sPath as String
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rMake In Range("D6:D" & lRow)
sPath = rMake.Offset(0,-1).Value
sPath = "\" & sPath
rMake.ClearComments
With rMake.AddComment
.Text ""
.Shape.Fill.UserPicture sPath & rMake.Value
End With
Next rMake
End Sub
Man könnte auch vor jedes Bild eine Inputbox hauen, in der der Pfad eingegeben wird ...
Du siehst, vieles kann man lösen.
Denk aber bitte daran, nur die wenigsten kennen deine Datei oder deine Pfadstruktur.
Grüße,
Klaus M.vdT.

Anzeige
AW: Bilder als Kommentar per Makro einfügen
19.02.2013 07:52:10
Lemmi
Hallo,
ja, das sind alles Lösungen die auch gut sind!
Da ich die Bilder innnerhalb einer Tabelle aus verschienden Ordner auslese ist eine Anpassung des Makro's sehr aufwendig es frst zuviel Zeit.
Meine Arbeitsumgebung und Tabellen sind Arbeitsliesten, diese werden von, mehren Personen genutzt und können nicht so einfach angepasst werden. "Ist leider festgefahren".
Das Makro
Sub MakePreviewPicComments()
Dim sPrev As String
Dim rMake As Range
Dim lRow As Long
Dim sPath as String
sPath = "C:\MeineBilder\" 'anpassen!!!
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rMake In Range("D6:D" & lRow)
rMake.ClearComments
With rMake.AddComment
.Text ""
.Shape.Fill.UserPicture sPath & rMake.Value
End With
Next rMake
End Sub
Gefällt mir gut. Kann mann nicht den "Fehler" des auslesensens überwinden?
So das Makro die Zelle ausliest.Damit hätte ich wieder alle Optionen.
Gruß
Lemmi

Anzeige
AW: Bilder als Kommentar per Makro einfügen
19.02.2013 08:23:42
Klaus
Hallo Lemmi,
Kann mann nicht den "Fehler" des auslesensens überwinden?
So das Makro die Zelle ausliest.Damit hätte ich wieder alle Optionen.

Ich habe leider keine Ahnung was du meinst. "Die Zelle ausliest" - das macht es doch schon.
.Shape.Fill.UserPicture sPath & rMake.Value
das fette ist doch der Zelleninhalt!
Wenn der String sPath & "/" & rMake.value keinen gültigen Pfad zu einer Bild-Datei ergibt, schmiert das Makro ab. Das könnte man abfangen. Am einfachsten wär natürlich ein "on error resume next" zu beginn des Makros, dann werden fehlerhafte Pfade einfach ignoriert und es wird kein Bild eingetragen.
Lemmi, ich möchte dir ja gerne helfen. Dafür musst du dich aber verständlich ausdrücken und mit mehr Infos rüberkommen. Ich frage dich: "wo stehen denn die Pfade zu den Dateien?" Du antwortest:
Meine Arbeitsumgebung und Tabellen sind Arbeitsliesten, diese werden von, mehren Personen genutzt und können nicht so einfach angepasst werden.
Tja. Jetzt weiss ich aber immer noch nicht, wo der Dateipfad steht :-)
Noch eine Version:
Sub PicsHausTerasse()
Call MakePreviePicComments("C:\Haus\Terasse\")
End Sub
Sub PicsKellerTuer()
Call MakePreviePicComments("C:\Haus\Keller\Tuer\")
End Sub
Sub EsIstEgalWieDasMakroZumAufrufenHeisstSolangeDerPfadStimmt()
Call MakePreviePicComments("C:\Haus\Keller\Sauna\Naktbilder\")
End Sub
Sub KleinesMakroNummerVier()
Call MakePreviewPicComments(sheets("Tabelle69").Range("V77"))
'natürlich muss in Tabelle 69, V77 ein gültiger Pfad stehen!
End Sub
Sub MakePreviewPicComments(sPath as string)
Dim sPrev As String
Dim rMake As Range
Dim lRow As Long
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rMake In Range("D6:D" & lRow)
rMake.ClearComments
With rMake.AddComment
.Text ""
.Shape.Fill.UserPicture sPath & rMake.Value
End With
Next rMake
End Sub
Das "Haupt" Makro wird über kleinere Makros aufgerufen, in denen jeweils der Pfad steht. Auf die gleiche Weise könnte auch die Tabelle oder der Bereich D6:D1000 variabel gehalten werden.
Statt den Pfad in den kleinen Makros "fix" zu schreiben, kannst du ihn da natürlich auch irgendwo herholen (siehe kleines Makro Nr. 4)
Hilft dir das?
Grüße,
Klaus M.vdT.

Anzeige
AW: Bilder als Kommentar per Makro einfügen
19.02.2013 09:39:42
Lemmi
Hallo Klaus,
ich glaube das sich alles aufkärt und ich meine Beschreibung etwas präzisiere:
also ich habe ein Add-Inn dieses heißt FileLister 1.22
Dieses kleine Programm listet mir das Gewünsche Verzeichnis mit Struktur aus.
In dem File Lister kann auch der vollständige Pfad ausgegeben werden.
also c:\.....\Bild01.jpg
In den Arbeitslisten sind mir die Dateinamen+ Verzeichnis jedoch viel zu lang und damit unübersichtlich.
Hier nehme ich folgende Option war:
Andere Ordner auswählen (...ich wähle das Hauptverzeichnis aus..)
Ausgabeoption:
Nur letzte Ebene anzeigen
Datei- Option
Dateinamen mit Hyperlink zu Datei
Ergebnis:
Die Bilder werden als Hyperlink gelistet.(nur Dateiname mit kürzel z.B.Bild01.jpg)
Diese Übericht wird von mir etwas nachbearbeitet, so dass ich alle Bildnamen untereinander gelistet habe.(D6-D1000)
... wenn ich das Marko Sub MakePreviewPicComments nehmen funktioniert dieses nur dann, wenn das ganze Verzeichnis+Bildname vorliegt sowie wenn die Bildnamen in der Spalte fortlaufend sind.
An dieser Stelle, könnte ich vieleicht noch einen neuen Ansatz finden.
Neue Idee:
Ich würde jetzt den vollständigen Pfadnamen mit FileLister auslesen.
Diese Liste bereite ich etwas nach.
So das alle gewünschen Bildnamen untereinander liegen
Nun wird das Sub MakePreviewPicComments gestartet.
Ergebnis: Langer Pfadname mit Bildname und Kommentarbild ist vorhanden.
Um die Übersichtlichkeit, die mir ja so wichtig ist, wieder herzustellen benötige ich eine Möglichkeit den Pfadnamen zu entfernen.
Hast Du da eine Idee?
Wenn das möglich ist, ja dann gäbe es auch eine Lösung die alles beinhaltet!
Gruß
Lemmi

Anzeige
AW: Bilder als Kommentar per Makro einfügen
19.02.2013 10:13:56
Klaus
Um die Übersichtlichkeit, die mir ja so wichtig ist, wieder herzustellen benötige ich eine Möglichkeit den Pfadnamen zu entfernen.
Hast Du da eine Idee?

Hi,
kannst du den Pfadnamen auch einzeln in eine Spalte legen? Irgendwo ganz weit rechts, wo sonst nix mehr steht (also zB D6: winter.jpg und IV6: c:\bilder\)
dann kann man den Pfad+Bildnamen einfach im VBA zusammenbauen und am Ende Spalte IV ganz löschen.
Oder man baut ein "Pfadnamen-Entfernen-Sub", das im Anschluss über den Bereich D6:D1000 drüber fährt.
Oder man macht das per Formel:
per "FindenVonRechts" ermittelst du die Position des letzten "/", mit der Textfunktion =RECHTS() bastelst du dir den Dateinamen wieder zusammen. Das geht zB so:
=MID(D6;FIND("#";SUBSTITUTE(D6;"\";"#";LEN(D6)-LEN(SUBSTITUTE(D6;"\";""))))+1;9^9)
=TEIL(D6;FINDEN("#";WECHSELN(D6;"\";"#";LÄNGE(D6)-LÄNGE(WECHSELN(D6;"\";""))))+1;9^9)
(deutsche Formel "aus dem Ärmel" übersetzt und ohne Garantie)
die o.g. Formel kopierst du von IV6:IV1000, dann kopierst du IV6:IV1000 mit Inhalte-Werte einfügen über den Bereich D6:D1000 und löscht danach Spalte IV. Das ganze kannst du dir einmal Makrorekordern, eventuell optimieren und einfach hinten an den vorhandenen Code anhängen.
Grüße,
Klaus M.vdT.

Anzeige
AW: Bilder als Kommentar per Makro einfügen
19.02.2013 11:10:22
Lemmi
Hallo Klaus,
da die Bild- Dateien immer wieder aktuallistert werden muss und ich keinen Datenmüll entstehen lassen möchte, favorisiere ich, das an Ort und Stelle der Pfadname gekürzt wird.
Damit würde ich mit der Lösung
....."Oder man baut ein "Pfadnamen-Entfernen-Sub", das im Anschluss über den Bereich D6:D1000 drüber fährt".am Bsesten fahren.
Hast eines?
-----------
=MID(D6;FIND("#";SUBSTITUTE(D6;"\";"#";LEN(D6)-LEN(SUBSTITUTE(D6;"\";""))))+1;9^9)
=TEIL(D6;FINDEN("#";WECHSELN(D6;"\";"#";LÄNGE(D6)-LÄNGE(WECHSELN(D6;"\";""))))+1;9^9)
kann ich erst heute Abend testen!
Gruß
Lemmi

Anzeige
Hingeschummelte Lösung:
19.02.2013 11:31:07
Klaus
Hi Lemmi,
ich hab mal die Formellösung in das VBA eingebaut (statt mich damit zu beschäftigen, wie man das sauber in VBA löst).
Annahme: in D6:D1000 stehen Dateien MIT Pfadangabe!
Nach dem Makro hat D6:D1000 keine Pfadangabe mehr vor dem Dateinamen, dafür einen Vorschau-Kommentar.
Spalte Z (Hilfsspalte) muss leer sein, oder im Makro an eine leere Spalte angepasst werden.
Sub MakePreviewPicComments()
Dim sPrev As String
Dim rMake As Range
Dim lRow As Long
Dim iColLeer As Integer
iColLeer = 26
'irgendeine leere Spalte - ich hab mal Spalte Z genommen.
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rMake In Range("D6:D" & lRow)
rMake.ClearComments
With rMake.AddComment
.Text ""
.Shape.Fill.UserPicture rMake.Value
End With
Cells(rMake.Row, iColLeer).FormulaR1C1 = "=MID(RC4,FIND(""#"",SUBSTITUTE(RC4,""\"",""# _
"",LEN(RC4)-LEN(SUBSTITUTE(RC4,""\"",""""))))+1,9^9)"
rMake.Value = Cells(rMake.Row, iColLeer).Value
Cells(rMake.Row, iColLeer).ClearContents
Next rMake
End Sub

AW: Hingeschummelte Lösung:
19.02.2013 20:12:36
Lemmi
Hallo Klaus
alles hat geklappt!
Aller bestenten Dank!
Gruß
Lemmi

Danke für die Rückmeldung! owT.
19.02.2013 21:24:32
Klaus
.

AW: Bilder als Kommentar per Makro einfügen
18.02.2013 09:05:38
Franz
Hallo Lemmi,
das gibt's nen schönen Code von Hans, den ich auch nicht im Detail verstehe, aber für mich abwandeln konnte, vielleicht hilft's Dir weiter:
Option Explicit
Option Private Module
Sub PicShow()
Dim pct As Picture
Dim cmt As Comment
Dim arr() As String
Dim arrPics() As Variant
Dim iFile As Integer, iRow As Integer, iCounter As Integer, iPattern As Integer
Dim iAll As Integer, iCol As Integer
Dim sPattern As String, sPath As String, sFile As String
Dim bln As Boolean
Application.ScreenUpdating = False
sPath = Range("B1").Value
Range("A4:D65536").Clear
iAll = 1
sPattern = "*.gif"
For iPattern = 1 To 2
arrPics = FileArray(sPath, sPattern)
Call QuickSort(arrPics) 'Prozedur s. unten
If arrPics(1) = False Then
If iPattern = 1 Then GoTo NEXTPATTERN
If IsEmpty(Range("A4")) Then
Beep
MsgBox "Im Verzeichnis """ & sPath & """ wurde keine Bilddatei gefunden!"
End If
GoTo ERRORHANDLER
End If
For iCounter = iAll To UBound(arrPics)
sFile = sPath & "\" & arrPics(iCounter)
ReDim Preserve arr(1 To 5, 1 To iCounter)
bln = True
Set pct = ActiveSheet.Pictures.Insert(sFile)
arr(1, iCounter) = sFile
arr(2, iCounter) = arrPics(iCounter)
arr(3, iCounter) = FileDateTime(sFile)
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
iAll = iCounter
NEXTPATTERN:
Erase arrPics
sPattern = "*.jpg"
Next iPattern
If bln = False Then
Beep
MsgBox "Es wurden keine Bilddateien gefunden -" & vbLf & _
"überprüfen Sie die eingetragenen Verzeichnisse!"
End If
Columns.AutoFit
ERRORHANDLER:
Application.ScreenUpdating = True
End Sub
Sub QuickSort(ByRef VA_array, Optional V_Low1, Optional V_high1)
On Error Resume Next
Dim V_Low2, V_high2, V_loop As Integer
Dim V_val1, V_val2 As Variant
If IsMissing(V_Low1) Then
V_Low1 = LBound(VA_array, 1)
End If
If IsMissing(V_high1) Then
V_high1 = UBound(VA_array, 1)
End If
V_Low2 = V_Low1
V_high2 = V_high1
V_val1 = VA_array((V_Low1 + V_high1) / 2)
While (V_Low2  V_val1 And _
V_high2 > V_Low1)
V_high2 = V_high2 - 1
Wend
If (V_Low2  V_Low1) Then Call _
QuickSort(VA_array, V_Low1, V_high2)
If (V_Low2 

Grüße
Franz

AW: Bilder als Kommentar per Makro einfügen
18.02.2013 12:17:59
Lemmi
Hallo zusammen,
das erste Makro, soweit ich das sehe, ruft erst eine Eingabe- Box auf , diese fragt nach dem Verzeichnis.
Abgesehen davon das Makro nicht zum laufen bekommen habe, ist das Verzeichnis ja schon bekannt!
Jede Zelle hat einen Dateinamen. Dieser Dateinname ist im eingentlichem sinne eine Hyperlink.
Damit müsste "nur" dem Verzeichnis gefolgt werden.
... wie gesagt bekomme ich das ganze nicht ans laufen.
Gruß
Lemmi

AW: Bilder als Kommentar per Makro einfügen
18.02.2013 12:28:18
Klaus
Hallo Lemmi,
ich möchte die Lösung von Franz sicherlich nicht herunterspielen, aber was spricht gegen meine Variante?
https://www.herber.de/forum/messages/1299753.html
Grüße,
Klaus M.vdT.

AW: Bilder als Kommentar per Makro einfügen
22.02.2013 22:56:54
Lemmi
Hallo Franz,
ich habe gerade versucht das Markoo an laufen zu bekommen!
Was muss ich tun um es an laufen zu bekommen?
Gruß
Lemmi

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige