Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
928to932
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
928to932
928to932
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Automatische Kommentare erstellen

Automatische Kommentare erstellen
27.11.2007 10:58:00
Bernd
Hallo an alle VB Cracks,
da mir keiner bei diesem Thread (https://www.herber.de/forum/archiv/928to932/t928681.htm) helfen konnte vielleicht aber nun mit anderem Denkanstoß.
Problem:
Ich habe in den Spalten H; I; J; ab Zeile 5 Hyperlinks zu Bildern und möchte für diese Zellen Automatische Kommentare generieren in denen dann das Bild angezeigt wird (so als Vorschau oder Info)
die Bilder hab ich in fester Größe, in einem Verzeichnis "Pics" abgelegt und werde sie dann vorlaufend Nummerieren wobei es schön wäre wenn der Kommentar das bild sich aus der URL in Spalte H; I; oder J automatisch holen könnte.
Ich denke es ist mal eine anspruchsvolle Sache oder ich bin einfach zu blöd (unwissend) um dies zu bewältigen ....
vielen Dank im Vorraus für eure Hilfe....
Gruß Bernd

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatische Kommentare erstellen
27.11.2007 12:37:21
Mag
... mit anderen Worten:

Sub ttt()
Dim cmt As Comment
Set cmt = ActiveCell.AddComment
With cmt.Shape
.Fill.UserPicture "c:\temp\otto.gif" 'Dein Bild
.Width = 100 'Breite
.Height = 100 'Höhe
End With
End Sub


Gruss

AW: Automatische Kommentare erstellen
27.11.2007 13:05:41
Bernd
Hi Mag dank dir schon mal für den Ansatz ...
jetzt müsten dann nur noch evt. die Varriablen und die Loops rein das er das für die 3 X 90 Zellen automatisch macht evt. über dim Zellen as range wobei zellen zum beispiel markierter Bereich wäre ?

Anzeige
AW: Automatische Kommentare erstellen
27.11.2007 13:54:51
Mag
hmm...Ansatz vielleicht so?:
Option Explicit

Sub ttt()
Dim cmt As Comment, hlink As Hyperlink
For Each hlink In Sheets(1).Hyperlinks
Range(ZellAdresse(Range("A1:A3"), hlink.Name)).Activate
Set cmt = ActiveCell.AddComment
With cmt.Shape
.Fill.UserPicture hlink.Address
.Width = 100
.Height = 100
End With
Next
End Sub




Function ZellAdresse(Bereich As Range, Name As String) As String
Dim rng As Range
For Each rng In Bereich
If rng = Name Then Exit For
Next
ZellAdresse = rng.Address
End Function


Gruss

Anzeige
AW: Automatische Kommentare erstellen
27.11.2007 14:06:00
Mag
leichte Verbesserung:
Option Explicit

Sub ttt()
Dim cmt As Comment, hlink As Hyperlink, str As String
For Each hlink In Sheets(1).Hyperlinks
str = ZellAdresse(Range("A1,A3"), hlink.Name)
If str  "" Then
Range(str).Activate
Set cmt = ActiveCell.AddComment
With cmt.Shape
.Fill.UserPicture hlink.Address
.Width = 100
.Height = 100
End With
End If
Next
End Sub




Function ZellAdresse(Bereich As Range, Name As String) As String
Dim rng As Range
For Each rng In Bereich
If rng = Name Then ZellAdresse = rng.Address: Exit Function
Next
ZellAdresse = ""
End Function


Gruss

Anzeige
AW: Automatische Kommentare erstellen
27.11.2007 14:11:00
Mag
... wobei Range("A1,A3") Dein Bereich ist mit Hyperlinks, die mit Bild versehen werden sollen.

AW: Automatische Kommentare erstellen
27.11.2007 14:22:00
Mag
und, Umgekehrter Weg über Range ist besser:

Sub fff()
Dim cmt As Comment, rng As Range
For Each rng In Range("A1,A3")
rng.Activate
Set cmt = ActiveCell.AddComment
With cmt.Shape
.Fill.UserPicture ActiveCell.Hyperlinks(1).Address
.Width = 100
.Height = 100
End With
Next
End Sub


Gruss

AW: Automatische Kommentare erstellen
27.11.2007 15:50:53
Bernd
geht schon nicht schlecht (er legt schon mal denn 1. Kommentar an) so aber ich bekomme so 2-3 Fehlerchen rein
1. habe jetzt mal "A1,A3" in "H6,J6" geändert sollte gehen
2. er zeigt mir an im Debugger das der Index außerhalb des Bereiches ist bei ".Fill.UserPicture ActiveCell.Hyperlinks(1).Address~f~"
hab es auch in 2 Methoden mit den Hyperlinks probiert
1. Methode "rechtsklick>Hyperlinks>....."
2. Methode "~f~=HYPERLINK("Pic_"&ZEILE()-5&"_1.jpg")"
werde jetzt aber noch mal deine 1. Varriante testen....

Anzeige
AW: Automatische Kommentare erstellen
27.11.2007 16:04:00
Bernd
leider Verabschiedet sich die (ttt) Variante bei mit mit Fehler 400......
*kratz hinterm Kopf* mal schauen vieleicht hast du ne Ahnung woran`s hängen kann ....werd aber auch noch mal weiter bastel.....
Gruß Bernd und Danke @

AW: Automatische Kommentare erstellen
27.11.2007 18:16:00
Josef
Hallo Bernd,
probier's mal so.
Sub CommendAddPicture()
Dim oCmnt As Comment
Dim rng As Range

For Each rng In Range("A1:A40")
    If rng.Hyperlinks.Count <> 0 Then
        If Dir(rng.Hyperlinks(1).Address) <> "" Then
            On Error Resume Next
            rng.Comment.Delete
            On Error GoTo 0
            rng.AddComment
            With rng.Comment.Shape
                .Fill.UserPicture rng.Hyperlinks(1).Address
                .Width = 100
                .Height = 100
            End With
        End If
    End If
Next
End Sub

Gruß Sepp

Anzeige
AW: Automatische Kommentare erstellen
28.11.2007 08:34:00
Bernd
wenn ich das ausprobiere in einer Leeren Arbeitsmappe geht es wunderbar auch das andere Makro von Mag aber in meiner vorhandenen Mappe leider nicht mal schauen wo es klemmt .......
****grrrrr****
aber danke schon mal !!!!!!!!
Rest werde ich dann schon finden (hoffe ich)

AW: Automatische Kommentare erstellen
28.11.2007 19:14:31
Josef
Hallo Bernd,
Stehen in den Zellen wirklich Hyperlinks?
Kannst du die Tabelle hochladen?
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige