Hyperlink zwischen Zelle und Reitername

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Hyperlink zwischen Zelle und Reitername
von: Marcus
Geschrieben am: 29.08.2015 00:31:39

Guten Abend,
ich habe folgende Herusforderung:
Ich lasse über eine Inputbox einen Namen eingeben (z.B. Marcus). Ist dieser Name (Marcus) im Reiter Überischt in der Spalte A vorhanden, dann wird ein neuer Reiter angelegt, der den eingegbenen Namen (Marcus) als Reiternamen bekommt. Soweit alles in Ordnung. Nun zu meiner Herausforderung:
Nun möchte ich, dass die Zelle, die den eingegebenen Namen (Marcus) in Spalte A im Reiter Übersicht hat, einen Hyperlink auf den Reiter "Marcus" bekommt. Also "STRG+K,Aktuelles Dokument,Zellbezug(z.B.Marcus)". So muss man nur auf den Namen in der Übersicht klicken und Excel springt auf den entsprechenden Reiter. Ist das machbar?
Ich bedanke mich für tolle Ideen und Vorschläge!
Marcus

Bild

Betrifft: AW: Hyperlink zwischen Zelle und Reitername
von: Sepp
Geschrieben am: 29.08.2015 01:13:02
Hallo Marcus,

Sub CreateSheetAndLink()
Dim vntRet As Variant, objSh As Worksheet
Dim strName As String

Do
  strName = Application.InputBox("Bitte geben Sie einen Namen ein", "Name", Type:=2)
  
  If strName = CStr(False) Then Exit Sub
  
  With Sheets("Übersicht")
    vntRet = Application.Match(strName, .Range("A:A"), 0)
    If IsNumeric(vntRet) Then
      Set objSh = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
      objSh.Name = .Cells(vntRet, 1).Text
      .Activate
      .Hyperlinks.Add .Cells(vntRet, 1), Address:="", _
        SubAddress:="'" & .Cells(vntRet, 1).Text & "'!A1"
      Exit Do
    Else
      MsgBox "Name nicht gefunden!"
    End If
  End With
Loop

Set objSh = Nothing
End Sub


Gruß Sepp


Bild

Betrifft: AW: Hyperlink zwischen Zelle und Reitername
von: Marcus
Geschrieben am: 29.08.2015 14:05:23
Hallo Sepp,
vielen Dank für deine Hilfe. Sieht soweit gut aus. Ich habe das mal ausprobiert und es funktioniert auch.
Wenn ich nun an Stelle "Set objSh = ThisWorkbook.Worksheets.Add" kein neues Blatt, sondern ein Reiter "Vorlage" kopieren möchte, muss ich dann nur aus "Add" ein "Copy" machen bzw. "Worksheets ("Vorlage").Copy"? Hier kommt bei mir ein Fehler (Objekt fehlt), als ich dein Vorschlag anpassen wollte.
Ein anschließende Frage zum Thema Hyperlinks: Kann ich ganz am Anfang bzw. in einem anderen Schritt / Makro den Reiter "Übersicht" auf Hyperlinks prüfen lassen, die keinen Bezug mehr haben, also "Bezug ungültig"? Ich stell mir vor, dass z.B. i-wann mal der Reiter "Marcus" angelegt und auch der Hyperlink gemacht wurde, aber der Mitarbeiter Marcus dann nicht mehr im Unternehmen ist und der Reiter gelöscht wurde. Der Hyperlink gibt dann "Bezug ungültig" raus.
Viele Grüße und nochmals ein großes Dankeschön für die Hilfe!
Marcus

Bild

Betrifft: AW: Hyperlink zwischen Zelle und Reitername
von: Sepp
Geschrieben am: 29.08.2015 14:40:34
Hallo Marcus,
das geht z. B. so.

Sub CreateSheetAndLink()
Dim vntRet As Variant, objSh As Worksheet
Dim strName As String
Dim objHL As Hyperlink, rng As Range

With Sheets("Übersicht")
  On Error Resume Next
  For Each objHL In .Hyperlinks
    If objHL.SubAddress <> "" Then
      Set rng = Nothing
      Set rng = Range(objHL.SubAddress)
      Err.Clear
      If rng Is Nothing Then objHL.Delete
    End If
  Next
  On Error GoTo 0
  strName = Application.InputBox("Bitte geben Sie einen Namen ein", "Name", Type:=2)
  Do
    If strName = CStr(False) Then Exit Sub
    vntRet = Application.Match(strName, .Range("A:A"), 0)
    If IsNumeric(vntRet) Then
      On Error Resume Next
      Set objSh = Sheets(.Cells(vntRet, 1).Text)
      Err.Clear
      On Error GoTo 0
      If objSh Is Nothing Then
        ThisWorkbook.Worksheets("Vorlage").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Set objSh = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        objSh.Name = .Cells(vntRet, 1).Text
        objSh.Visible = xlSheetVisible
      End If
      .Activate
      .Hyperlinks.Add .Cells(vntRet, 1), Address:="", _
        SubAddress:="'" & objSh.Name & "'!A1"
      Exit Do
    Else
      MsgBox "Name nicht gefunden!"
    End If
  Loop
End With

Set objSh = Nothing
End Sub



Gruß Sepp


Bild

Betrifft: Achtung! nimm diesen Code!
von: Sepp
Geschrieben am: 29.08.2015 14:54:23
Hallo Marcus,
der vorherige Code läuft in eine Endlos-Schleife.

Sub CreateSheetAndLink()
Dim vntRet As Variant, objSh As Worksheet
Dim strName As String
Dim objHL As Hyperlink, rng As Range

With Sheets("Übersicht")
  On Error Resume Next
  For Each objHL In .Hyperlinks
    If objHL.SubAddress <> "" Then
      Set rng = Nothing
      Set rng = Range(objHL.SubAddress)
      Err.Clear
      If rng Is Nothing Then objHL.Delete
    End If
  Next
  On Error GoTo 0
  
  Do
    strName = Application.InputBox("Bitte geben Sie einen Namen ein", "Name", Type:=2)
    If strName = CStr(False) Then Exit Sub
    vntRet = Application.Match(strName, .Range("A:A"), 0)
    If IsNumeric(vntRet) Then
      On Error Resume Next
      Set objSh = Sheets(.Cells(vntRet, 1).Text)
      Err.Clear
      On Error GoTo 0
      If objSh Is Nothing Then
        ThisWorkbook.Worksheets("Vorlage").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Set objSh = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        objSh.Name = .Cells(vntRet, 1).Text
        objSh.Visible = xlSheetVisible
      End If
      .Activate
      .Hyperlinks.Add .Cells(vntRet, 1), Address:="", _
        SubAddress:="'" & objSh.Name & "'!A1"
      Exit Do
    Else
      MsgBox "Name nicht gefunden!"
    End If
  Loop
End With

Set objSh = Nothing
End Sub


Gruß Sepp


Bild

Betrifft: AW: Achtung! nimm diesen Code!
von: Marcus
Geschrieben am: 29.08.2015 22:36:08
Hallo Sepp,
das Makro läuft SUPER! Vielen Dank für die Hilfe.
Viele Grüße
Marcus

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Hyperlink zwischen Zelle und Reitername"