Supportnet / Forum / Tabellenkalkulation
Grafik automatisch in Kommentar einfügen (vom 23.03.2006)
Frage
Hallo Allerseits,
ich habe ausoben genannten Beitrag eine sehr gute Lösung für mein Problem gefunden. Mein Code sieht wie folgt aus:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Value
Case "ausgestellt"
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:="" & Chr(10) & ""
ActiveCell.Comment.Shape.Height = 623.25
ActiveCell.Comment.Shape.Width = 425.25
ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\......." & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg"
End Select
Die Bildnummer wird in aktiver Zeile bei Spalte A herausgesucht.
Klappt soweit alles wunderbar.
Jetzt habe ich nur ein Problem:
Hat der Benutzer aber vorher vergessen, die Bilddatei zu erstellen (Dateiname ist die aktuelle Vorgangsnummer also z.B. "764.jpg") wird trotzdem ein Kommentar erstellt, welches natürlich leer ist. Diesen Fehler würde ich gerne durch eine Prüfung, ob die Bilddatei im Verzeichnis vorhanden ist, umgehen und dann einen Hinweis ausgeben.
Leider weiß ich nicht, wie die Überprüfung des Kommentares geschrieben werden muß, ob ein Bild darin enthalten ist oder ob man im Verzeichnis überprüft, ob eine Bildatei mit der aktuellen Vorgangsnummer abgespeichert wurde.
Könnt Ihr mir helfen ??
Danke und Gruß
Thomas
Antwort 1 von nighty
hi thomas :-)
ein kleines beispiel,duerfte klarheit schaffen :-)
noch kurzbeschreibung
aus der activen zelle wird der dateinamen gelesen
wenn datei vorhanden ist wird das kommentarfeld der activen zelle mit dem bild befuellt
gruss nighty
ein kleines beispiel,duerfte klarheit schaffen :-)
noch kurzbeschreibung
aus der activen zelle wird der dateinamen gelesen
wenn datei vorhanden ist wird das kommentarfeld der activen zelle mit dem bild befuellt
gruss nighty
Sub test()
On Error GoTo fehler
Dim Bpfad As String
Dim Bbild As String
Dim mywidth As Long
Dim myheight As Long
Bbild = ".jpg"
Bpfad = "D:\Briefe\micha\jpg\"
With Application.FileSearch
.NewSearch
.LookIn = Bpfad
.SearchSubFolders = False
.Filename = Cells(ActiveCell.Row, ActiveCell.Column) & Bbild
If .Execute() > 0 Then
ActiveSheet.Pictures.Insert(Bpfad & Cells(ActiveCell.Row, ActiveCell.Column) & Bbild).Select
mywidth = Selection.Width
myheight = Selection.Height
Selection.Delete
Cells(ActiveCell.Row, ActiveCell.Column).AddComment
Application.DisplayCommentIndicator = xlCommentAndIndicator
Cells(ActiveCell.Row, ActiveCell.Column).Comment.Shape.Select True
With Selection.ShapeRange
.Width = mywidth
.Height = myheight
End With
Selection.ShapeRange.Fill.UserPicture Bpfad & Cells(ActiveCell.Row, ActiveCell.Column) & Bbild
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
Cells(ActiveCell.Row, ActiveCell.Column).Comment.Visible = False
End If
End With
End
fehler:
If Err = 1004 Then Resume Next
End Sub
Antwort 2 von nighty
hi thomas :-)
der hinweis koennte ueber eine msgbox erfolgen
gruss nighty
der hinweis koennte ueber eine msgbox erfolgen
gruss nighty
Antwort 3 von XDuckX-Fan
Hi nighty,
danke für deine schnelle Antwort.
Ist dein Code jetzt nur die Überprüfung oder stellt er die gesammte Prozedur mit " Grafik automatisch in Kommentar einfügen" dar, in der dann automatisch die Überprüfung erfolgt und ich somit meinen Code nicht mehr benutzen kann / brauch
Gruß
Thomas
danke für deine schnelle Antwort.
Ist dein Code jetzt nur die Überprüfung oder stellt er die gesammte Prozedur mit " Grafik automatisch in Kommentar einfügen" dar, in der dann automatisch die Überprüfung erfolgt und ich somit meinen Code nicht mehr benutzen kann / brauch
Gruß
Thomas
Antwort 4 von XDuckX-Fan
Hallo nighty,
leider funktioniert dein Code nicht, es wird kein Kommentar mit Bild eingefügt. Habe versucht, deinen Code anzupassen, jedoch ohne Erfolg.
Hier mal eine etwas genauere Beschreibung:
Der Kommentar soll in Spalte AS ab Zeile 3 erstellt werden, dazu muß in der Zelle per Dropdown das Wort "ausgestellt" ausgewählt werden.
Nur wenn :
Select Case Target.Value
Case "ausgestellt"
erfüllt ist, soll der Kommentar mit Bild in der aktiven Zelle erstellt werden, wie schon oben lt. Code beschrieben:
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:="" & Chr(10) & ""
ActiveCell.Comment.Shape.Height = 623.25
ActiveCell.Comment.Shape.Width = 425.25
ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\......." & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg"
Die Bild-ID wird in der aktiven Zeile aus Spalte A herausgesucht und im vorgegebenen Verzeichnis "V:\.....\..." /& Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg" herausgesucht.
Sollte die Bild-ID im vorgegebenen Verzeichnis nicht vorhanden sein, soll ein Hinweis durch eine Msgbox (wie du ja selbst schon vorgeschlagen hast) erscheinen.
Bei genau dieser Routine ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\......." & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg" würde ich gerne auf z.B. On Error GoTo Fehler2 verweisen.
Fehler2 soll dann lauten:
Fehler2:
Selection.ClearContents
Selection.ClearComments
MsgBox "Fehler blablablabla Fehler"
End
Gibt es keine Möglichkeit, die ActiveCell.Comment.Shape.Fill.UserPicture... - Anweisung zu überprüfen, ob ein Bild im Kommentar geladen wurde, oder vorher zu überprüfen, ob die ausgewählte Bild-ID durch
"V:\......." & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg" überhaupt vorhanden ist und wenn nicht, dann auf Fehler2 verweisen??
Hab schon einiges ausprobiert, aber irgendwie will es nicht klappen.
Währe Dir / Euch sehr dankbar, wenn Ihr dafür eine Lösung habt.
Gruß
Thomas
leider funktioniert dein Code nicht, es wird kein Kommentar mit Bild eingefügt. Habe versucht, deinen Code anzupassen, jedoch ohne Erfolg.
Hier mal eine etwas genauere Beschreibung:
Der Kommentar soll in Spalte AS ab Zeile 3 erstellt werden, dazu muß in der Zelle per Dropdown das Wort "ausgestellt" ausgewählt werden.
Nur wenn :
Select Case Target.Value
Case "ausgestellt"
erfüllt ist, soll der Kommentar mit Bild in der aktiven Zelle erstellt werden, wie schon oben lt. Code beschrieben:
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:="" & Chr(10) & ""
ActiveCell.Comment.Shape.Height = 623.25
ActiveCell.Comment.Shape.Width = 425.25
ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\......." & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg"
Die Bild-ID wird in der aktiven Zeile aus Spalte A herausgesucht und im vorgegebenen Verzeichnis "V:\.....\..." /& Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg" herausgesucht.
Sollte die Bild-ID im vorgegebenen Verzeichnis nicht vorhanden sein, soll ein Hinweis durch eine Msgbox (wie du ja selbst schon vorgeschlagen hast) erscheinen.
Bei genau dieser Routine ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\......." & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg" würde ich gerne auf z.B. On Error GoTo Fehler2 verweisen.
Fehler2 soll dann lauten:
Fehler2:
Selection.ClearContents
Selection.ClearComments
MsgBox "Fehler blablablabla Fehler"
End
Gibt es keine Möglichkeit, die ActiveCell.Comment.Shape.Fill.UserPicture... - Anweisung zu überprüfen, ob ein Bild im Kommentar geladen wurde, oder vorher zu überprüfen, ob die ausgewählte Bild-ID durch
"V:\......." & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg" überhaupt vorhanden ist und wenn nicht, dann auf Fehler2 verweisen??
Hab schon einiges ausprobiert, aber irgendwie will es nicht klappen.
Währe Dir / Euch sehr dankbar, wenn Ihr dafür eine Lösung habt.
Gruß
Thomas
Antwort 5 von Beverly
Hi Thomas,
ob eine Datei vorhanden ist, kannst du mit diesem Prinzip-Cpde überprüfen
Bis später,
Karin
ob eine Datei vorhanden ist, kannst du mit diesem Prinzip-Cpde überprüfen
Sub datei_vorhanden()
Dim fsObject
Set fsObject = CreateObject("Scripting.FileSystemObject")
If fsObject.fileexists("C:\Excel_Test\hintergrund.jpg") Then MsgBox "Datei vorhanden"
End Sub
Bis später,
Karin
Antwort 6 von XDuckX-Fan
Hallo Karin,
ich danke dir für deine Hilfe.
Hier der komplette Code für die autom. Kommentarerstellung:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Value
Case "ausgestellt"
ActiveCell.ClearComments
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:="" & Chr(10) & ""
ActiveCell.Comment.Shape.Height = 623.25
ActiveCell.Comment.Shape.Width = 425.25
ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\....\" & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg"
End Select
Ich habe dabei nur ein Problem:
Wie binde ich deinen Code in meinen ein, um a: eine vorherige oder zeitgleiche Überprüfung durchzuführen, wenn, wie in meinem oben aufgeführten Code die Bilddatei in den Kommentar geladen wird mit: ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\....\" & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg", und b: ohne eine Fehlermeldung zu erhalten, denn wenn ich zwischen Case "ausgestellt" und End Select eine IF-Anweisung einfüge, erhalte ich die Fehlermeldung: End Select ohne Select Case.
Das der Code von nighty nicht funktioniert, liegt mit Sicherheit auch nur daran, daß er von mir falsch angepasst wurde, sooo gut kenne ich mich mit VB nun auch nicht aus, bisher hat's jedoch immer gereicht.
Wenn keine entsprechende Bildatei im Verzeichnis vorhanden ist, wird mir ein leerer Kommentar erstellt, muß dann halt damit leben, falls zwischen Select Case... und End Select keine Überprüfung möglich ist oder der Kommentar in der aktiven Zelle nicht überprüft werden kann, ob ein Bild darin vorhanden ist oder nicht.
Vielleicht hat ja doch noch jemand 'ne Idee, ansonsten erst mal Danke an Alle, die sich damit befasst haben. :-)
Gruß
Thomas
ich danke dir für deine Hilfe.
Hier der komplette Code für die autom. Kommentarerstellung:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Value
Case "ausgestellt"
ActiveCell.ClearComments
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:="" & Chr(10) & ""
ActiveCell.Comment.Shape.Height = 623.25
ActiveCell.Comment.Shape.Width = 425.25
ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\....\" & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg"
End Select
Ich habe dabei nur ein Problem:
Wie binde ich deinen Code in meinen ein, um a: eine vorherige oder zeitgleiche Überprüfung durchzuführen, wenn, wie in meinem oben aufgeführten Code die Bilddatei in den Kommentar geladen wird mit: ActiveCell.Comment.Shape.Fill.UserPicture _
"V:\....\" & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg", und b: ohne eine Fehlermeldung zu erhalten, denn wenn ich zwischen Case "ausgestellt" und End Select eine IF-Anweisung einfüge, erhalte ich die Fehlermeldung: End Select ohne Select Case.
Das der Code von nighty nicht funktioniert, liegt mit Sicherheit auch nur daran, daß er von mir falsch angepasst wurde, sooo gut kenne ich mich mit VB nun auch nicht aus, bisher hat's jedoch immer gereicht.
Wenn keine entsprechende Bildatei im Verzeichnis vorhanden ist, wird mir ein leerer Kommentar erstellt, muß dann halt damit leben, falls zwischen Select Case... und End Select keine Überprüfung möglich ist oder der Kommentar in der aktiven Zelle nicht überprüft werden kann, ob ein Bild darin vorhanden ist oder nicht.
Vielleicht hat ja doch noch jemand 'ne Idee, ansonsten erst mal Danke an Alle, die sich damit befasst haben. :-)
Gruß
Thomas
Antwort 7 von Beverly
Hi Thomas,
die Prüfung schiebst du zwischen die 1. und 2. Zeile deines Codes
Bis später,
Karin
die Prüfung schiebst du zwischen die 1. und 2. Zeile deines Codes
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim fsObject
Set fsObject = CreateObject("Scripting.FileSystemObject")
If Not fsObject.fileexists("C:\Excel_Test\" & Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Value & ".jpg") Then
MsgBox "Datei nicht vorhanden"
Exit Sub
End If
Select Case Target.Value
Case "ausgestellt"
....
Bis später,
Karin
Antwort 8 von XDuckX-Fan
Hi Karin,
Klasse, funktioniert soweit wunderbar. Gibt es noch die die Möglichkeit, deine Überprüfung nur auf Spalte AS auszuführen, wie z.B.
If Target.Address("$AS$3:$AS$30000") = "ausgestellt" Then ... dann dein Code, da ich die MsgBox-Meldung auch auf anderen Spalten erhalte.
danke schon mal im vorraus für alles.
Gruß
Thomas
Klasse, funktioniert soweit wunderbar. Gibt es noch die die Möglichkeit, deine Überprüfung nur auf Spalte AS auszuführen, wie z.B.
If Target.Address("$AS$3:$AS$30000") = "ausgestellt" Then ... dann dein Code, da ich die MsgBox-Meldung auch auf anderen Spalten erhalte.
danke schon mal im vorraus für alles.
Gruß
Thomas
Antwort 9 von Beverly
Hi Thomas,
schreibe nach der Zeile Dim fsObject foldende 2 Zeilen
Bis später,
Karin
schreibe nach der Zeile Dim fsObject foldende 2 Zeilen
If Intersect(Target, Range("AS3:AS30000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Bis später,
Karin
Antwort 10 von XDuckX-Fan
Hi Karin,
SUUUPER, funktioniert jetzt alles wunderbar.
Ich danke dir und auch allen anderen, die sich damit beschäftigt haben.
Vielleicht hört man sich ja beim nächsten Problem wieder :-)
Bis dahin....
wünsche ein schönes Wochenende
Gruß
Thomas
SUUUPER, funktioniert jetzt alles wunderbar.
Ich danke dir und auch allen anderen, die sich damit beschäftigt haben.
Vielleicht hört man sich ja beim nächsten Problem wieder :-)
Bis dahin....
wünsche ein schönes Wochenende
Gruß
Thomas