View Full Version : Solved: Some sheets no hyperlinks.
Pinokkio
02-24-2010, 11:11 AM
This macro sheets, the "Invoice", "Customers", "Debtor" and "Articles" may not have hyperlinks to return to sheet "Inhoudsopgave ?
Anyone an idea?
Sub Inhouds_opgave()
'Met dank aan Nate Oliver
Dim ws As Worksheet, wsNw As Worksheet, N As Integer
Set wsNw = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1))
With wsNw
1: .Name = "Inhoudsopgave"
On Error GoTo 0
.[C4] = "Tabblad"
.[C4].Font.Size = 10
.[C4].Font.Bold = True
.[D4] = "Naam"
.[D4].Font.Size = 10
.[D4].Font.Bold = True
N = 6
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> .Name Then
.Cells(N, 4) = ws.Name
With .Cells(N, 3)
.Value = N - 5
.HorizontalAlignment = xlCenter
End With
.Hyperlinks.Add _
Anchor:=.Cells(N, 4), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
With ws
.[a3] = Sheets(1).Name
.[a3].Hyperlinks.Add _
Anchor:=.Cells(3, 1), _
Address:="", _
SubAddress:="'" & Sheets(1).Name & "'!A1"
End With
N = N + 1
End If
Next
End With
Exit Sub
2: Application.DisplayAlerts = False
Sheets("Inhoudsopgave").Delete
Application.DisplayAlerts = True
GoTo 1
End Sub
Thanks…
P.
Option Explicit
Sub Inhouds_opgave()
'Met dank aan Nate Oliver
Dim ws As Worksheet, wsNw As Worksheet, N As Integer
Set wsNw = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1))
With wsNw
.Name = "Inhoudsopgave"
'On Error GoTo 0
.[C4] = "Tabblad"
'.[C4].Font.Size = 10
'.[C4].Font.Bold = True
.[D4] = "Naam"
.[C4:D4].Font.Size = 10
.[C4:D4].Font.Bold = True
End With
N = 6
For Each ws In ThisWorkbook.Worksheets
If Not (ws.Name = wsNw.Name) Then
'On wsNw, Add Hyperlink to: ws
wsNw.Select
wsNw.Cells(N, 4) = ws.Name
wsNw.Cells(N, 3).Value = N - 5
wsNw.Cells(N, 3).HorizontalAlignment = xlCenter
wsNw.Hyperlinks.Add _
Anchor:=Cells(N, 4), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
'On ws, add hyperlink to: wsNw
ws.Select
ws.Cells(3, 1) = wsNw.Name
ws.Hyperlinks.Add _
Anchor:=Cells(3, 1), _
Address:="", _
SubAddress:="'" & wsNw.Name & "'!A1"
End If
N = N + 1
Next 'Next worksheet
Exit Sub
'2: Application.DisplayAlerts = False
' 'Sheets(wsNw).Delete
' Application.DisplayAlerts = True
' GoTo 1
End Sub
domfootwear
02-24-2010, 09:25 PM
Pls try this code:
Option Explicit
Sub Inhouds_opgave()
Application.DisplayAlerts = False
'Met dank aan Nate Oliver
Dim ws As Worksheet, wsNw As Worksheet, N As Integer
Set wsNw = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1))
For Each ws In ThisWorkbook.Sheets
If ws.Name = "Inhoudsopgave" Then
ws.Delete
End If
Next ws
With wsNw
.Name = "Inhoudsopgave"
'On Error GoTo 0
.[C4] = "Tabblad"
'.[C4].Font.Size = 10
'.[C4].Font.Bold = True
.[D4] = "Naam"
.[C4:D4].Font.Size = 10
.[C4:D4].Font.Bold = True
End With
N = 4
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Invoice" And ws.Name <> "Debtor" And ws.Name _
<> "Customers" And ws.Name <> "Articles" Then
If Not (ws.Name = wsNw.Name) Then
'On wsNw, Add Hyperlink to: ws
wsNw.Select
wsNw.Cells(N, 3).Value = N - 4
wsNw.Cells(N, 3).HorizontalAlignment = xlCenter
wsNw.Cells(N, 4) = ws.Name
wsNw.Hyperlinks.Add _
Anchor:=Cells(N, 4), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
'On ws, add hyperlink to: wsNw
ws.Select
ws.Cells(3, 1) = wsNw.Name
ws.Hyperlinks.Add _
Anchor:=Cells(3, 1), _
Address:="", _
SubAddress:="'" & wsNw.Name & "'!A1"
End If
End If
N = N + 1
Next 'Next worksheet
Exit Sub
'2: Application.DisplayAlerts = False
' 'Sheets(wsNw).Delete
Application.DisplayAlerts = True
' GoTo 1
End Sub
Pinokkio
02-25-2010, 06:18 AM
SamT & domfootwear,
Thanks for reply but all the sheets get a hyperlink?
P.
In my code, first sheet, "Inhoudsopgave", gets links to other sheets.
Other sheets get link to "Inhoudsopgave".
What do you want?
SamT
Pinokkio
02-25-2010, 09:33 AM
Sorry for that.
Other sheets get link to "Inhoudsopgave".
This macro sheets, the "Invoice", "Customers", "Debtor" and "Articles" may not have hyperlinks to return to sheet "Inhoudsopgave ?
Take this part out
'On wsNw, Add Hyperlink to: ws
wsNw.Select
wsNw.Cells(N, 4) = ws.Name
wsNw.Cells(N, 3).Value = N - 5
wsNw.Cells(N, 3).HorizontalAlignment = xlCenter
wsNw.Hyperlinks.Add _
Anchor:=Cells(N, 4), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
Pinokkio
02-25-2010, 02:02 PM
Thanks.
P.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.