Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Hyperlink ergänzen

Betrifft: Hyperlink ergänzen von: Jack_d
Geschrieben am: 01.08.2014 11:35:13

Hallo Gemeinde

Es ist Freitag, Es ist warm und ich kann nicht mehr klar denken und bräuchte kurz eure Hilfe

Und zwar erstelle ich mitr folgendem MAkro ein sogg. Raumbuch
Kurzbeschreibung des Makros
1. es durchsucht nimmt aus allen relevanten Blättern die Räume incl. verschiedener anderer Parameter
2. es trägt diese in ein neues Sheet ein
3. mit externen Funktionen lösche ich verschiedene Einträge und Formatiere den ganzen Spaß

Sub Raumbuch_erstellen(control As IRibbonControl)

Dim Datensammler As Variant
Application.ScreenUpdating = False

Set WB = ActiveWorkbook
blaetter = BlaetterF - 1
DatenLauf = 0

If blaetter <= 0 Then Exit Sub

ReDim Datensammler(1 To 4, 0 To blaetter)

''Sammeln

For Each WS In WB.Worksheets
    If IsNumeric(Left(WS.Name, 1)) Then
        
        
        Datensammler(1, DatenLauf) = WS.Cells(5, 8)     'FABname
        Datensammler(2, DatenLauf) = WS.Cells(6, 8)     'Sub-Titel
        Datensammler(3, DatenLauf) = WS.Name            'Blattname
        Datensammler(4, DatenLauf) = WS.Range("B10:H51").Value   'Räume
        
        
        
        DatenLauf = DatenLauf + 1
     Else
       
    End If
Next WS


If Blattpruefen("Raumbuch") = False Then
Else
Application.DisplayAlerts = False
    Worksheets("Raumbuch").Delete
Application.DisplayAlerts = True

End If
    WB.Worksheets.Add Before:=Sheets(1)
    ActiveSheet.Name = "Raumbuch"

'' Eintragen
With Worksheets("Raumbuch")
    For i = 0 To UBound(Datensammler, 2)
        On Error GoTo errorhdl
        LZeile = .Cells(Rows.Count, 8).End(xlUp).Row
    
        .Cells(LZeile, 1).Resize(41, 7) = Datensammler(4, i)
        AlZeile = .Cells(Rows.Count, 8).End(xlUp).Row
        
        For Awerte = 1 To 41
            .Cells(AlZeile + Awerte, 8) = Datensammler(1, i)
            .Cells(AlZeile + Awerte, 9) = Datensammler(2, i)
            .Cells(AlZeile + Awerte, 10) = Datensammler(3, i)
        Next Awerte
        
    Next i
End With

Zeilenloeschen ("Raumbuch")
Raumformat ("Raumbuch")

Exit Sub
errorhdl:
MsgBox "Fehler in Zeile " & EintragZeile
Resume Next
End Sub
Nun mein anliegen. Ich würde gern die Räume (Kommend aus den 2. Spalten der Mappen -> gehen in Spalte 1 des Raumbuches) mit Hyperlinks unterlegen
Sprich: Klick auf den Raum und man landet auf dem Worksheet auf dem entsprechenden Raum

Ich hoffe es war einigermaßen verständlich ausgedrück, ich kann mich heut selber kaum verstehen -.-#

Und vielen Dank für Eure Unterstützung

  

Betrifft: Habs doch Irgendwie Lösen können von: Jack_d
Geschrieben am: 01.08.2014 12:34:45

Und Falls es jemanden interessiert

Im Block "Eintragen" hab ich die entsprechende Routine ergänzt

Ist zwar nicht ganz " sauber" funktioniert aber in meinem Fall ganz gut

'' Eintragen
With Worksheets("Raumbuch")
    For i = 0 To UBound(Datensammler, 2)
        On Error GoTo errorhdl
        LZeile = .Cells(Rows.Count, 8).End(xlUp).Row
    
        .Cells(LZeile, 1).Resize(41, 7) = Datensammler(4, i)
        AlZeile = .Cells(Rows.Count, 8).End(xlUp).Row
        
        For Awerte = 1 To 41
            .Cells(AlZeile + Awerte, 8) = Datensammler(1, i)
            .Cells(AlZeile + Awerte, 9) = Datensammler(2, i)
            .Cells(AlZeile + Awerte, 10) = Datensammler(3, i)
            
            ' Zellen für Hyperlink einfügen
            Name = .Cells(AlZeile + Awerte, 1).Value
            If Name = "" Then Name = " "
            
            .Hyperlinks.Add _
            Anchor:=.Cells(AlZeile + Awerte, 1), _
            Address:="", _
            SubAddress:=CStr("'" & Datensammler(3, i) & "'" & "!" & "B" & Awerte + 10), _
            TextToDisplay:=Name
        
        Next Awerte
        
    Next i
Grüße


 

Beiträge aus den Excel-Beispielen zum Thema "Hyperlink ergänzen"