Check alle échte Black Friday-deals Ook zo moe van nepaanbiedingen? Wij laten alleen échte deals zien

[Excel 2003] Formateren van selection.value in sheet *

Pagina: 1
Acties:

  • Strangelove
  • Registratie: Mei 2008
  • Laatst online: 06-02 01:01
[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.

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

  • _WgV_
  • Registratie: Februari 2002
  • Laatst online: 23-11 20:20

_WgV_

It's a magical world!

Uit de macro recorder:

Visual Basic:
1
2
3
4
    With Selection
        .Font.ColorIndex = 5
        .Font.Underline = xlUnderlineStyleSingle
    End With


Edit:
En je moet dit toepassen op het cell object en niet op het value object (een value is immers slechts een waarde, die kan geen format hebben)

[ Voor 31% gewijzigd door _WgV_ op 29-05-2008 01:26 ]

#StopBurningStuff


  • Strangelove
  • Registratie: Mei 2008
  • Laatst online: 06-02 01:01
Ja, zo ver kom ik ook nog wel maar het probleem is dat de cellen waarin de de selection.value komt te staan niet in vooraf bekende cellen komt te staan. Dus weet ik niet ook niet voor welke cellen of selectie ik die formatering moet toe laten passen...

But, but..dank voor het meedenken... ;-)

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Ik heb even [code]..[/code] tags om je code gezet. Zet zelf de indentation (het inspringen) even terug zodat het nog leesbaar wordt ook :)

Ik heb niet goed naar de code gekeken, maar vind .Select gebruiken trouwens meestal onhandig en onnodig. Het is me uit je vraag niet duidelijk welke selectie je bedoeld. Als ik het zo lees zou _WgV_ 1 het correct zeggen: gewoon selection.font... zetten. Welke selection durf ik uit je vraag + geleende code niet zien :)

offtopic:
1 underscores rule \o/

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


  • onkl
  • Registratie: Oktober 2002
  • Laatst online: 11:46
Strangelove schreef op donderdag 29 mei 2008 @ 02:15:
Ja, zo ver kom ik ook nog wel maar het probleem is dat de cellen waarin de de selection.value komt te staan niet in vooraf bekende cellen komt te staan. Dus weet ik niet ook niet voor welke cellen of selectie ik die formatering moet toe laten passen...

But, but..dank voor het meedenken... ;-)
Synax als
Visual Basic:
1
Range("A1").Select

(regel 28 en verder)
kan je beter omschrijven als
Visual Basic:
1
2
dim slim_gekozen_naam as range
set slim_gekozen_naam = range("A1")

Dan kan je altijd refereren aan die naam, in plaats van aan selection.
Verderop (regel 84&85) gebruik je trouwens activecell in plaats van een gedefinieerde range. Dat is -op z'n zachtst- een beetje link.
offtopic:
Het is op GoT te doen gebruikelijk geen grote lappen code te dumpen, maar alleen het stukje waar je problemen mee hebt. Hoe meer werk het voor derden is je vraag te beantwoorden, hoe kleiner de kans dat ze het doen. :)