[Excel 2003]
Ik heb een macro die op een nieuwe sheet een aantal selection.value geeft.
In feite zijn dit tekstkopjes voor gevonden informatie.
Nu heb ik nog een make-up issue'tje:
Kan ik die selection.value formateren (bijvoorbeeld blauw en onderstreept en kan ik er een lege rij onder positioneren ?
Ter info: het betreft de volgende macro om Excel Links en Named Ranges te vinden.
Bij voorbaat dank, Mark Houben
Ik heb een macro die op een nieuwe sheet een aantal selection.value geeft.
In feite zijn dit tekstkopjes voor gevonden informatie.
Nu heb ik nog een make-up issue'tje:
Kan ik die selection.value formateren (bijvoorbeeld blauw en onderstreept en kan ik er een lege rij onder positioneren ?
Ter info: het betreft de volgende macro om Excel Links en Named Ranges te vinden.
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
| Sub Linked_File_Listing() 'Written by Barrie Davidson Dim FilesLinked As Variant Dim LinkedFilesCount As Integer Dim SheetCount As Integer Dim counter As Integer Dim FileCounter As Integer Dim LinkAddress As String Dim LinkedFileName As String Dim PositionCounter As Integer Dim PositionRow As Integer Dim PositionColumn As Integer Dim FirstOccurrence As String Application.ScreenUpdating = False On Error Resume Next FilesLinked = ActiveWorkbook.LinkSources If IsError(FilesLinked(1)) = True Then MsgBox prompt:="No Links Exist", Buttons:=vbInformation + vbOKOnly Exit Sub Else End If LinkedFilesCount = UBound(FilesLinked) Sheets(1).Activate Sheets.Add Range("A1").Value = "Current list as of " & Format$(Now(), "mmmm d, yyyy") Range("A2").Select FileCounter = 1 Do Until FileCounter > LinkedFilesCount Selection.Value = "LINKED FILE" Selection.Offset(1, 0).Value = FilesLinked(FileCounter) Selection.Offset(0, 1).Select FileCounter = FileCounter + 1 Loop 'Do Until FileCounter > LinkedFilesCount If MsgBox("List each cell containing a link ?", vbYesNo, _ "THE FIRM") = vbNo Then Range("A2:" & Range("A2").End(xlToRight).Address).Select Selection.EntireColumn.Select Selection.EntireColumn.AutoFit Range("A1").Select Exit Sub Else End If Range("A4").Select FileCounter = 1 Do Until FileCounter > LinkedFilesCount LinkedFileName = "" PositionCounter = 1 Do Until LinkedFileName = "\" LinkedFileName = Mid(FilesLinked(FileCounter), Len(FilesLinked(FileCounter)) - PositionCounter, 1) PositionCounter = PositionCounter + 1 Loop 'Do Until LinkedFileName = "\" LinkedFileName = Mid(FilesLinked(FileCounter), Len(FilesLinked(FileCounter)) - PositionCounter + 2) Selection.Value = "FILE LINKED CELL LOCATIONS" Selection.Offset(1, 0).Select Sheets(2).Activate SheetCount = ActiveWorkbook.Sheets.Count counter = 2 Do Until counter > SheetCount 'Put hyperlinks to each linked cell Range("A1").Select FindAddresses: If IsError(Cells.Find(What:=LinkedFileName, _ After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate) = True Then Else FirstOccurrence = ActiveCell.Address LinkAddress = "'" & ActiveCell.Worksheet.Name & "'!" & ActiveCell.Address Sheets(1).Activate ActiveCell.Numbe2rFormat = "@" ActiveCell.Value = "'" & LinkAddress ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _ LinkAddress ActiveCell.Offset(1, 0).Select Sheets(counter).Activate Cells.Find(What:=LinkedFileName, _ After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate Do Until ActiveCell.Address = FirstOccurrence LinkAddress = "'" & ActiveCell.Worksheet.Name & "'!" & ActiveCell.Address Sheets(1).Activate ActiveCell.NumberFormat = "@" ActiveCell.Value = "'" & LinkAddress ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _ LinkAddress ActiveCell.Offset(1, 0).Select Sheets(counter).Activate Cells.Find(What:=LinkedFileName, _ After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate Loop 'Do Until ActiveCell.Address = FirstOccurrence End If counter = counter + 1 Sheets(counter).Activate PositionRow = 0 PositionColumn = 0 Loop 'Do Until Counter > SheetCount 'added this to get named ranges Sheets(1).Activate ActiveCell.Offset(1, 0).Activate ActiveCell.Value = "NAMED RANGES" ActiveCell.Offset(1, 0).Activate If ActiveWorkbook.Names.Count = 0 Then Else For counter = 1 To ActiveWorkbook.Names.Count If InStr(ActiveWorkbook.Names(counter), LinkedFileName) <> 0 Then ActiveCell.Value = """" & ActiveWorkbook.Names(counter).Name _ & """" & " refers to " & ActiveWorkbook.Names(counter) ActiveCell.Offset(1, 0).Select End If Next counter End If 'end of getting named ranges FileCounter = FileCounter + 1 Sheets(1).Activate ActiveCell.Offset(0, 1).End(xlUp).Offset(1, 0).Activate Loop 'Do Until FileCounter > LinkedFilesCount Sheets(1).Activate Range("A2:" & Range("A2").End(xlToRight).Address).Select Selection.EntireColumn.Select Selection.EntireColumn.AutoFit Range("A1").Select Application.ScreenUpdating = True End Sub |
Bij voorbaat dank, Mark Houben