Office: (Office 2010) Mit Makro erzeugte Grafik in bekannter Zelle finden/auswählen

Hallo,

ich habe eine etwas kniffigere Aufgabe, wo ich nicht weiß, wie ich am Besten heran gehen soll.

Ich habe in einem Makro eine Art Bauroutine für das grafische Design des Excel Sheets geschrieben, in welcher in bekannten Zellen gleichschenklige Dreiecke gezeichnet und mit einem Hyperlink versehen werden.

Die Spalten, welche jeweils eines dieser Dreiecke beinhalten, werden via QuickSort (geht nicht anders) alphabetisch sortiert. Somit müsse auch die Hyperlinks "mitwandern". Dafür muss ich aber die entsprechenden Objekte "finden" und auswählen, ohne das dessen Bezeichnung bekannt ist.

Meine Fragen daher:

Wie stelle ich es codetechnisch an, dass ich

A) die Objekte finde
B) die gefundenen Objekte auswähle/selektiere
C) den Hyperlinktext aus ihnen auslesen kann

Ich hoffe mir kann hier einer der Profis helfen. Ich kenne einfach eine Vielzahl der Excel funktionen nicht.

Vielen Dank im Voraus und bis dahin

Terry

 

Hi Terry,

woran erkennst du die Objekte - an ihrer Position im Tabellenblatt? Dann musst du in einer Schleife über alle Shapes im Tabellenblatt laufen und prüfen, ob TopLeftCell.Address mit der entsprechenden Zelladresse übereinstimmt.
Mit "Hyperlinktext" meinst du die Quickinfo?

Code:

ActiveSheet.Shapes("Gleichschenkliges Dreieck 2").Hyperlink.ScreenTip

Bis später,
Karin

 

Huhu,

ja ich kenne die Zellen, in welchen die Objekte vorhanden sind.

Code:

Function Find_Object(Zelle As Range) As Boolean
For Each obj In Zelle.Worksheet.DrawingObjects
    If Not Intersect(Zelle, Range(obj.TopLeftCell, obj.BottomRightCell)) Is Nothing Then
        Find_Object = True
        Exit Function
    End If
Next
End Function

Die Funktion gibt aber nur zurüc, ob ein Objekt in der übergebenen Zelle gefunden wurde, oder nicht. Ich muss aber (denke ich) das gefunde Objekt "auswählen", damit ich von diesem den Hyperlink Inhalt auslesen und danach durch einen Anderen ersetzen kann.

 

Hi,

wie du an die Informationen aus dem Hyperlink kommst hatte ich bereits geschrieben und ändern kann man diese nach demselben Prinzip - man muss dazu nichts selektieren.
Ob du allerdings ScreenTip oder Address auslesen/ändern musst hängt davon an, wohin der Link führt.

Bis später,
Karin

 

Ich wüsste nicht, wie mir der Code weiterhelfen soll, da es der 2. vor dem 1. Schritt ist. Ich kenne die Bezeichnung des Objectes in der Zelle nicht und solange ich diese nicht kenne kann ich mit dem Objekt nicht arbeiten .

 

Selbstverständlich musst du deine Function entsprechend anpassen, damit du das Objekt (warum nicht einfach Shape?) als Rückgabe erhältst

Code:

Sub HylinkAendern()
    Dim shaDreieck As Shape
    Set shaDreieck = Find_Object(Range("E3"))
    If Not shaDreieck Is Nothing Then
        With shaDreieck
            MsgBox shaDreieck.Hyperlink.Name
        End With
    Else
        MsgBox "Auf der Zelle liegt kein Dreieck"
    End If
End Sub

Function Find_Object(Zelle As Range) As Shape
    Dim shaShape As Shape
    For Each shaShape In ActiveSheet.Shapes
        If Not Intersect(Zelle, Range(shaShape.TopLeftCell, shaShape.BottomRightCell)) Is Nothing Then
            Set Find_Object = shaShape
            Exit Function
        End If
    Next
End Function

Bis später,
Karin

 

Hey vielen Dank es funktioniert. Kannst du mir noch sagen, mit welchem Befehl ich dem Objekt einen neuen Hyperlink vergeben kann?

 

Code:

    If Not shaDreieck Is Nothing Then
        ActiveSheet.Hyperlinks.Add Anchor:=shaDreieck, Address:="NeueAdresse"
    Else
        MsgBox "Auf der Zelle liegt kein Dreieck"
    End If

Bis später,
Karin

 

Genau das hatte ich probiert und der Compiler meckerte. Blöderweisehängt es jetzt wieder am ersten Teil.... ich schmeiß das Teil gleich aus dem Fenster. Dagegen ist C++ ja Kinderkram...

Code:

aFeld(lLauf, rLauf) = HylinkAendern(Range(lSpalte & lZeile), 0, "")

In lSpalte steht zum Testzeitpunkt ein "O" und lZeile eine "16"

Code:

'Hyperlink der grafischen Objekte für Sortierung ändern
Function HylinkAendern(ByVal Zelle As Range, Operator As Integer, HyperlinkText As String) As String
    Dim shaDreieck As Shape
    Set shaDreieck = Find_Object(Zelle)
    'Hyperlink lesen
    If Not shaDreieck Is Nothing Then
        If Operator = 0 Then
            With shaDreieck
                HylinkAendern = shaDreieck.Hyperlink.Name
            End With
        End If
    Else
        MsgBox "Auf der Zelle liegt kein Dreieck"
    End If
    'Hyperlink schreiben
    If Not shaDreieck Is Nothing Then
        If Operator = 1 Then
            With shaDreieck
                  ActiveSheet.Hyperlinks.Add Anchor:=shaDreieck, Address:=HyperlinkText
            End With
        End If
    Else
        MsgBox "Auf der Zelle liegt kein Dreieck"
    End If
End Function
'grafisches Objekt in Zelle finden
Function Find_Object(ByVal Zelle As Range) As Shape
    Dim shaShape As Shape
    For Each shaShape In ActiveSheet.Shapes
        If Not Intersect(Zelle, Range(shaShape.TopLeftCell, shaShape.BottomRightCell)) Is Nothing Then
            Set Find_Object = shaShape
            Exit Function
        End If
    Next
End Function

Komischerweise ist das übergebene Range immer "Leer"... Egal ob ich ein fixes Range übergebe -> immer "Leer"

 

Was soll aFeld(lLauf, rLauf) sein?

Bis später,
Karin

 

Edit: Ich weiß nicht, wieso es nach einem Programmneustart nun geht, aber es funktioniert es. Das tat es auch anfänglich und dann auf einmal nicht mehr.

ich danke Dir vielmals für deine Hilfe.