Hyperlink in Pivot möglich?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro1() Dim rngFind As Range Dim LCount As Long With Sheets("Tabelle4") 'Deine Privottabelle LCount = Application.WorksheetFunction.CountIf(.UsedRange, "*www.*") For LCount = 1 To LCount If rngFind Is Nothing Then Set rngFind = .UsedRange.Find("*www.*", , xlFormulas, xlPart, xlByRows, xlNext, False, False) Else Set rngFind = .UsedRange.FindNext(rngFind) End If If Not rngFind Is Nothing Then rngFind.Hyperlinks.Add rngFind, rngFind.Text Next LCount End With End Sub

Sub Makro1() Dim rngFind As Range Dim LCount As Long With Sheets("Daten") 'Deine Privottabelle LCount = Application.WorksheetFunction.CountIf(.UsedRange, "*www.*") For LCount = 1 To LCount If rngFind Is Nothing Then Set rngFind = .UsedRange.Find("*http*", , xlFormulas, xlPart, xlByRows, xlNext, False, _ False) Else Set rngFind = .UsedRange.FindNext(rngFind) End If If Not rngFind Is Nothing Then rngFind.Hyperlinks.Add rngFind, rngFind.Text Next LCount End With End Sub

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Count = 1 And InStr(Target, "http") > 0 Then Cancel = True ActiveWorkbook.FollowHyperlink Address:=Target.Text, NewWindow:=True End If End Sub

Hallo,
müsste so gehen.
kommt als Code in die Privot

Option Explicit 
 
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
Const Str_Die_Ersten As String = _
"http://www..." 'hier die ersten 70 Zeichen eintragen 
  
 If Target.Count = 1 And Target.Font.Underline = 2 Then 
  Cancel = True 
  ActiveWorkbook.FollowHyperlink Address:=Str_Die_Ersten & Target.Text, NewWindow:=True 
 End If 
 
End Sub

kommt als Code in Modul1

Sub Makro1() 
Dim rngFind As Range 
Dim LCount As Long 
 
 
With Sheets("Tabelle4") 'Deine Privottabelle 
 
    LCount = Application.WorksheetFunction.CountIf(.UsedRange, "http*") 
 
    For LCount = 1 To LCount 
     If rngFind Is Nothing Then 
      Set rngFind = .UsedRange.Find("http*", , xlFormulas, xlPart, xlByRows, xlNext, False, False) 
     Else 
      Set rngFind = .UsedRange.FindNext(rngFind) 
     End If 
      
     If Not rngFind Is Nothing Then 
      rngFind.Hyperlinks.Add rngFind, rngFind.Text, , , Right(rngFind.Text, Len(rngFind.Text) - 70) 
     End If 
     
    Next LCount 
     
 
End With 
 
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Hyperlink in Pivot möglich?

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread