Sulprobil
Search…
sbGetCell
You can retrieve interesting information about worksheet cells by using the Excel4 macro function GET.CELL. Define the name HasFormula with the value =GET.CELL(48,INDIRECT("RC[-1]",FALSE)) for example. If you now insert =HasFormula next right to a cell, you will be shown whether the cell has a formula (“True”) or not (“False”).
Another example for GET.CELL you can find at IT documentation.
If you want to achieve similar results with VBA use a UDF like this:
Please read my Disclaimer.
1
Function sbGetCell(r As Range, s As String) As Variant
2
'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbgetcell-1
3
'V0.32 30-Jul-2020 (C) (P) by Bernd Plumhoff
4
With Application.WorksheetFunction
5
Application.Volatile
6
Select Case s
7
Case "AbsReference", "1"
8
'Absolute style reference like $A$1
9
If Application.Caller.Parent.Parent.Name = _
10
r.Worksheet.Parent.Name And _
11
Application.Caller.Parent.Name = r.Worksheet.Name Then
12
sbGetCell = r.Address
13
Else
14
If InStr(r.Worksheet.Parent.Name & _
15
r.Worksheet.Name, " ") > 0 Then
16
sbGetCell = "'[" & r.Worksheet.Parent.Name & "]" & _
17
r.Worksheet.Name & "'!" & r.Address
18
Else
19
sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
20
r.Worksheet.Name & "!" & r.Address
21
End If
22
End If
23
Case "RowNumber", "2"
24
'Row number in the top cell reference
25
sbGetCell = r.Row
26
Case "ColumnNumber", "3"
27
'Column number of the leftmost cell in reference
28
sbGetCell = r.Column
29
Case "Type", "4"
30
'Same as TYPE(reference)
31
sbGetCell = -IsEmpty(r) - .IsNumber(r) - .IsText(r) * 2 - .IsLogical(r) _
32
* 4 - .IsError(r) * 16 - IsArray(r) * 64
33
Case "Contents", "5"
34
'Contents of reference
35
sbGetCell = r.Value
36
Case "FormulaLocal", "6"
37
'Cell formula
38
sbGetCell = r.FormulaLocal
39
Case "NumberFormat", "7"
40
'Number format of cell
41
sbGetCell = r.NumberFormatLocal
42
Case "HorizontalAlignment", "8"
43
'Number indicating the cell's horizontal alignment
44
Select Case r.HorizontalAlignment
45
Case xlGeneral
46
sbGetCell = 1
47
Case xlLeft
48
sbGetCell = 2
49
Case xlCenter
50
sbGetCell = 3
51
Case xlRight
52
sbGetCell = 4
53
Case xlFill
54
sbGetCell = 5
55
Case xlJustify
56
sbGetCell = 6
57
Case xlCenterAcrossSelection
58
sbGetCell = 7
59
Case xlDistributed
60
sbGetCell = 8
61
Case Else
62
Debug.Assert False 'Should not get here
63
End Select
64
Case "LeftBorderStyle", "9"
65
'Number indicating the left-border style assigned to the cell
66
Select Case r.Borders(1).LineStyle
67
Case xlLineStyleNone
68
sbGetCell = 0
69
Case xlHairline
70
sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 2, 7)
71
Case xlDot
72
sbGetCell = 4
73
Case xlDashDotDot
74
sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 12, 11)
75
Case xlDashDot
76
sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 10, 9)
77
Case xlDash
78
sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 8, 3)
79
Case xlSlantDashDot
80
sbGetCell = 13
81
Case xlDouble
82
sbGetCell = 6
83
Case Else
84
sbGetCell = CVErr(xlErrValue)
85
End Select
86
Case "RightBorderStyle", "10"
87
'Number indicating the right-border style assigned to the cell
88
Select Case r.Borders(2).LineStyle
89
Case xlLineStyleNone
90
sbGetCell = 0
91
Case xlHairline
92
sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 2, 7)
93
Case xlDot
94
sbGetCell = 4
95
Case xlDashDotDot
96
sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 12, 11)
97
Case xlDashDot
98
sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 10, 9)
99
Case xlDash
100
sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 8, 3)
101
Case xlSlantDashDot
102
sbGetCell = 13
103
Case xlDouble
104
sbGetCell = 6
105
Case Else
106
sbGetCell = CVErr(xlErrValue)
107
End Select
108
Case "TopBorderStyle", "11"
109
'Number indicating the top-border style assigned to the cell
110
Select Case r.Borders(3).LineStyle
111
Case xlLineStyleNone
112
sbGetCell = 0
113
Case xlHairline
114
sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 2, 7)
115
Case xlDot
116
sbGetCell = 4
117
Case xlDashDotDot
118
sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 12, 11)
119
Case xlDashDot
120
sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 10, 9)
121
Case xlDash
122
sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 8, 3)
123
Case xlSlantDashDot
124
sbGetCell = 13
125
Case xlDouble
126
sbGetCell = 6
127
Case Else
128
sbGetCell = CVErr(xlErrValue)
129
End Select
130
Case "BottomBorderStyle", "12"
131
'Number indicating the bottom-border style assigned to the cell
132
Select Case r.Borders(4).LineStyle
133
Case xlLineStyleNone
134
sbGetCell = 0
135
Case xlHairline
136
sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 2, 7)
137
Case xlDot
138
sbGetCell = 4
139
Case xlDashDotDot
140
sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 12, 11)
141
Case xlDashDot
142
sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 10, 9)
143
Case xlDash
144
sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 8, 3)
145
Case xlSlantDashDot
146
sbGetCell = 13
147
Case xlDouble
148
sbGetCell = 6
149
Case Else
150
sbGetCell = CVErr(xlErrValue)
151
End Select
152
Case "Pattern", "13"
153
'Number indicating cell pattern
154
sbGetCell = r.Interior.Pattern
155
Case "IsLocked", "14"
156
'True if cell is locked
157
sbGetCell = r.Locked
158
Case "FormulaHidden", "15"
159
'True if cell formula is hidden
160
sbGetCell = r.FormulaHidden
161
Case "Width", "16"
162
'Cell width. If array-entered into two cells of a row,
163
'second value is true if width is standard
164
sbGetCell = Array(r.ColumnWidth, r.UseStandardWidth) 'Not width!
165
Case "Height", "17"
166
'Cell height
167
sbGetCell = r.RowHeight
168
Case "FontName", "18"
169
'Cell font name
170
sbGetCell = r.Font.Name
171
Case "FontSize", "19"
172
'Cell font size
173
sbGetCell = r.Font.Size
174
Case "IsBold", "20"
175
'Cell is formatted bold?
176
sbGetCell = r.Font.Bold
177
Case "IsItalic", "21"
178
'Cell is formatted in Italics?
179
sbGetCell = r.Font.Italic
180
Case "IsUnderlined", "22"
181
'Cell is formatted as underlined?
182
sbGetCell = (r.Font.Underline = xlUnderlineStyleSingle Or _
183
r.Font.Underline = xlUnderlineStyleSingleAccounting Or _
184
r.Font.Underline = xlUnderlineStyleDouble Or _
185
r.Font.Underline = xlUnderlineStyleDoubleAccounting)
186
Case "IsStruckThrough", "23"
187
'Cell characters are struck through?
188
sbGetCell = r.Font.Strikethrough
189
Case "FontColorIndex", "24"
190
'Cell font color of first character, 1-56, 0 = automatic
191
sbGetCell = r.Font.ColorIndex
192
Case "IsOutlined", "25", "IsShaddowed", "26"
193
'Cell font is outlined or shaddowed? (Not supported by Excel)
194
sbGetCell = False
195
Case "PageBreak", "27"
196
'0 = no break, 1 = row, 2 = column, 3 = row and column
197
sbGetCell = -(r.EntireRow.PageBreak <> xlPageBreakNone) - 2 * (r.EntireColumn.PageBreak <> xlPageBreakNone)
198
Case "RowLevelOutline", "28"
199
'Row level outline
200
sbGetCell = r.EntireRow.OutlineLevel
201
Case "ColumnLevelOutline", "29"
202
'Row level outline
203
sbGetCell = r.EntireColumn.OutlineLevel
204
Case "IsSummaryRow", "30"
205
'Row is a summary row?
206
sbGetCell = r.EntireRow.Summary
207
Case "IsSummaryColumn", "31"
208
'Column is a summary column?
209
sbGetCell = r.EntireColumn.Summary
210
Case "WorkbookSheetName", "32"
211
'Workbook name like [Book1.xls]Sheet1 or Book1.xls if
212
'workbook and single sheet have
213
'identical names
214
If r.Worksheet.Parent.Name = r.Worksheet.Name & ".xls" And _
215
Application.Worksheets.Count = 1 Then
216
sbGetCell = r.Worksheet.Parent.Name
217
Else
218
sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
219
r.Worksheet.Name
220
End If
221
Case "IsWrapped", "33"
222
'Cell text is formatted as wrapped?
223
sbGetCell = r.WrapText
224
Case "LeftBorderColorIndex", "34"
225
'Left border color index
226
sbGetCell = r.Borders.Item(1).ColorIndex
227
Case "RightBorderColorIndex", "35"
228
'Right border color index
229
sbGetCell = r.Borders.Item(2).ColorIndex
230
Case "TopBorderColorIndex", "36"
231
'Top border color index
232
sbGetCell = r.Borders.Item(3).ColorIndex
233
Case "BottomBorderColorIndex", "37"
234
'Bottom border color index
235
sbGetCell = r.Borders.Item(4).ColorIndex
236
Case "ShadeForeGroundColor", "38", "PatternBackGroundColor", "64"
237
'ShadeForeGroundColor
238
sbGetCell = r.Interior.PatternColorIndex
239
Case "ShadeBackGroundColor", "39", "PatternForeGroundColor", "63"
240
'ShadeBackGroundColor
241
sbGetCell = r.Interior.ColorIndex
242
Case "TextStyle", "40"
243
'Style of the cell, as text
244
sbGetCell = r.Style.NameLocal
245
Case "FormulaWOT", "41"
246
'Returns the formula in the active cell without translating it (useful for international macro sheets)
247
sbGetCell = r.Formula
248
'Case "HDistWinToLCell", "42"
249
' 'Horizontal distance, measured in points, from the left edge of the active window to the left edge of the cell
250
' sbGetCell = r. 'Does not work yet
251
Case "HasNote", "46"
252
'True if cell contains a text note
253
sbGetCell = Len(r.NoteText) > 0
254
Case "HasSound", "47"
255
'True if cell has a sound note. Not supported.
256
sbGetCell = False
257
Case "HasFormula", "48"
258
'True if cell contains a formula
259
sbGetCell = r.HasFormula
260
Case "IsArray", "49"
261
'True if cell is part of an array formula
262
sbGetCell = r.HasArray
263
Case "VerticalAlignment", "50"
264
'1 = Top, 2 = Center, 3 = Bottom, 4 = Justified, 5 = Distributed
265
sbGetCell = -(r.VerticalAlignment = xlVAlignTop) - 2 * (r.VerticalAlignment = xlVAlignCenter) - _
266
3 * (r.VerticalAlignment = xlVAlignBottom) - 4 * (r.VerticalAlignment = xlVAlignJustify) - _
267
5 * (r.VerticalAlignment = xlVAlignDistributed)
268
Case "VerticalOrientation", "51"
269
'0 = Horizontal, 1 = Vertical, 2 = Upward, 3 = Downward
270
sbGetCell = -(r.Orientation = xlVertical) - 2 * (r.Orientation = xlUpward) - _
271
3 * (r.Orientation = xlDownward)
272
Case "IsStringConst", "52"
273
'Text alignment char "'" if cell is a string constant,
274
'empty string "" if not
275
sbGetCell = r.PrefixCharacter
276
Case "AsText", "53"
277
'Cell displayed as text with numbers formatted and symbols included
278
sbGetCell = r.Text
279
Case "PivotTableViewName", "54"
280
'PivotTableViewName
281
sbGetCell = r.PivotTable.Name
282
'Case "PivotTableViewPosition", "55"
283
' 'PivotTableViewPosition
284
' sbGetCell = r.PivotField.Position 'Not correct yet
285
Case "PivotTableViewFieldName", "56"
286
'PivotTableViewFieldName
287
sbGetCell = r.PivotField.Name
288
Case "IsSuperscript", "57"
289
'Cell text is formatted as superscript?
290
sbGetCell = r.Font.Superscript
291
Case "FontStyleText", "58"
292
'FontStyleText
293
sbGetCell = r.Font.FontStyle
294
Case "UnderlineStyle", "59"
295
'Underline style, 1 = none, 2 = single, 3 = double, 4 = single accounting, 5 = double accounting
296
Select Case r.Font.Underline
297
Case xlUnderlineStyleNone
298
sbGetCell = 1
299
Case xlUnderlineStyleSingle
300
sbGetCell = 2
301
Case xlUnderlineStyleDouble
302
sbGetCell = 3
303
Case xlUnderlineStyleSingleAccounting
304
sbGetCell = 4
305
Case xlUnderlineStyleDoubleAccounting
306
sbGetCell = 5
307
Case Else
308
sbGetCell = CVErr(xlErrValue)
309
End Select
310
Case "IsSubscript", "60"
311
'Cell text is formatted as subscript?
312
sbGetCell = r.Font.Subscript
313
Case "PivotTableItemName", "61"
314
'PivotTableItemName
315
sbGetCell = r.PivotItem.Name
316
Case "WorksheetName", "62"
317
'Worksheet name like [Book1.xls]Sheet1
318
sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
319
r.Worksheet.Name
320
Case "IsAddIndentAlignment", "65"
321
'Only Far East Excel Versions
322
sbGetCell = False 'Not supported here
323
Case "WorkbookName", "66"
324
'Workbook name like Book1.xls
325
sbGetCell = r.Worksheet.Parent.Name
326
Case "IsHidden"
327
'Cell hidden?
328
sbGetCell = r.EntireRow.Hidden Or r.EntireColumn.Hidden
329
Case Else
330
sbGetCell = CVErr(xlErrValue)
331
End Select
332
End With
333
End Function
Copied!
Last modified 1yr ago
Copy link