Automatisering af hyperlinks mellem ark

Jeg havde forestillet mig en løsning hvor excel søgte på hele kolonne A i ark1, ark2 og ark3 og derefter opslog de samme numre i kolonne A i ark4?

Men om der findes et henvisningsværktøj ud over de manuelle hyperlinks i Excel, ved jeg ikke.

Der er forresten tale om Excel 2007.

Via VBA skulle det kunne lade sig gøre - hvis det kunne være en mulighed.

Hvordan det bliver gjort er faktisk ikke så vigtigt :) Der er allerede lidt vba kode i det dokument jeg sidder med.

Og hvis det bliver gjort ved hjælp af de samme funktioner som det manuelle hyperlink, ville det være drøn smart hvis man kunne benytte skærmtip til at oplyse 2 tal som står i henholdsvis kolonne L og M i samme række det givne nummeret gør i ark4.

Gerne opdelt af bindestreg f.eks. Skærmtip: [100 - 200]

Dvs. kolonne L & M er på Ark4?

Ja, skærmtippet skal gerne komme når man holder musen over et af numrene i kolonne A i henholdsvis ark1, ark2 og ark3.

Og når man så endeligt klikker på det givne nummer bliver man smidt til ark 4 på den række hvor det tilsvarende nummer er.

Er det helt umuligt? :)

Vedr. skærmtip er det noget jeg skal eksperimentere lidt med - men ellers skulle det være muligt.

vender tilbage senere - har en opgave jeg skal videre med...

Skærmtippet vil udelukkende være en alletiders bonus :)

Men tror vi skal være opmærksomme på det faktum at numrene i ark1, ark2 og ark3 kan ændres, og bl.a. skabes de ved hjælp af formlen (sidste nummer+1). Der er ikke tale om stationære tal :)

Ok - som sagt -> vender tilbage

Vil lade super om at svare, men måske en hjælp påvej med skærmtippet til løsningen:

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "http://www.google.dk/", ScreenTip:="En søgemaskine", TextToDisplay:= _
        "Google"

Så kan man evt. lave en sammenkædning i en celle, hvis det skulle være værdi fra celle 3 til celle 4 fx. =sammenkædning(C3;"-";C4)
også ændre ScreenTip:=range("D4").Value

alternativ - uafhænig af hyperlinks - indsættes i ThisWorkbook.

Skærmtip vises p.t. i StatusBar - alternativer:
- i kommentarer, der oprettes automatisk
- userform (minimalistisk, der sværver over arkene)

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If InStr(Target.Address, ":") = 0 And ActiveSheet.Index < 4 Then
        If Target.Column = 1 And IsNumeric(Target.Value) = True And Target.Value <> "" Then
            ark4Ræk = søgArk4(Target.Value)
            If ark4Ræk > 0 Then
                ActiveWorkbook.Sheets(4).Activate
                Range("A" & CStr(ark4Ræk)).Select
                Cancel = True
            End If
        End If
    End If
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Application.StatusBar = ""
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim nr As Long, ark4Ræk As Long, info As String
    Application.StatusBar = ""

    If InStr(Target.Address, ":") = 0 Then
        If Target.Column = 1 And IsNumeric(Target.Value) = True And Target.Value <> "" Then
            ark4Ræk = søgArk4(Target.Value)
            If ark4Ræk > 0 Then
                With ActiveWorkbook.Sheets(4)
                    info = .Cells(ark4Ræk, 12) & " - " & .Cells(ark4Ræk, 13)
                    Application.StatusBar = info
              End With
            End If
        End If
    End If
End Sub
Private Function søgArk4(nr)
    fejlkilde = "findCelleAdr"

    With ActiveWorkbook.Sheets(4).Range("A1:A65000")
        Set c = .Find(nr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            søgArk4 = c.Row
        Else
            søgArk4 = 0
        End If
    End With
End Function

Skærmtippet fungerer rigtig fint, kanon idé med at smide det ned i statuslinjen, så er vi jo tilmed fri for at den skulle overlappe en eventuel tekst i cellerne når markøren holdes over nummeret :)

Hvad angår hyperlinks, er det på nogen måde muligt?

Vender tilbage...

Rem OPRET HYPERLINKS
Rem ================
Private Sub workbook_activate()
Dim arkNr As Byte, ræk As Long, nr As Long, ræk4 As Integer, tipTekst As String
    For arkNr = 1 To 3
        ActiveWorkbook.Sheets("Ark" & CStr(arkNr)).Select
        For ræk = 1 To 65000
            If Cells(ræk, 1) = "" Then
                Exit For
            Else
                nr = Cells(ræk, 1)
                ræk4 = søgArk4(nr, tipTekst)
                If ræk4 > 0 Then
                    Cells(ræk, 1).Select
                    opretHyperLink ræk4, tipTekst
                End If
            End If
        Next ræk
    Next arkNr

MsgBox ("Hyperlinks er opbygget")
End Sub
Private Sub opretHyperLink(række, tipTekst)
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'Ark4'!A" & CStr(række), ScreenTip:=tipTekst
End Sub
Private Function søgArk4(nr, tipTekst)
    fejlkilde = "findCelleAdr"

    With ActiveWorkbook.Sheets(4).Range("A1:A65000")
        Set c = .Find(nr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            søgArk4 = c.Row
            tipTekst = .Range("L" & CStr(søgArk4)) & "-" & .Range("M" & CStr(søgArk4))
        Else
            søgArk4 = 0
            tipTekst = ""
        End If
    End With
End Function

Hvordan aktiveres ovenstående? :)

Indlægges i Thisworkbook i VBA - opstartes når filen åbnes

Den kommer rigtigt nok med en popup når jeg åbner dokumentet, men tallene i kolonne A bliver ikke omdannet til hyperlinks på de 3 første ark (som skal henvise til det 4. ark)

mystisk - jeg oplever at hyperlinks indsættes som de skal.

Meddelsen kommer når opbygningen er udført. Er der ikke en lille streg under talle i kolonne A.

Elles er du velkommen til at få min model -
send en mail - @-adresse under min profil.

nogen afklaring?