File naming cleanup excel - includes RegisterFunction help in excel
Excel function registration for variable by variable at Stack Overflow https://stackoverflow.com/questions/14731675/is-there-a-way-to-make-udf-that-gives-a-description-like-the-native-excel-functi/21917614#21917614
Attribute VB_Name = "RevitFileNames"
Attribute VB_Name = "RevitFileNames"
Public Function CleanStr(strIN As String, Optional ReplaceChar As String = "-", Optional SpacesToDashes As Boolean = True) As String
Attribute CleanStr.VB_Description = "Remove characters that could interfere with file naming"
Attribute CleanStr.VB_ProcData.VB_Invoke_Func = " \n9"
Dim I ''generic counter
Dim replaceStr As String ''for building replacement string
Dim x As String ''character
Dim Pass As Boolean ''Pass/fail for character
For I = 1 To Len(strIN)
x = "": x = Mid(strIN, I, 1)
Pass = False ''reset for next character
Select Case x
Case "(" To ")" ''include prenthesis
Pass = True
Case "A" To "Z"
Pass = True
Case "a" To "z"
Pass = True
Case "0" To "9"
Pass = True
Case " "
If SpacesToDashes Then
x = "-"
Else
Pass = False
End If
Case "-"
If x = Right(NameFilter, 1) Then ''no double or multi dashes
Pass = False
Else
Pass = True
End If
Case Chr(34)
x = "_in"
Pass = True
Case Else
x = ReplaceChar
If x = Right(NameFilter, 1) Then
Pass = False
Else
Pass = True
End If
End Select
If Pass Then CleanStr = CleanStr & x
End Function
Private Sub testSpecial()
Dim a As String
a = NameFilter("~!@#$%^&*()_+`1234567890-WERTYUIOP{ASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm,{}[]:" & """" & ";'<>,.?/\|")
Debug.Print a
End Sub
Sub RegisterMyFunction()
''https://stackoverflow.com/questions/4262421/how-to-put-a-tooltip-on-a-user-defined-function
''(strIN As String, Optional ReplaceChar As String, Optional SpacesToDashes As Boolean) As String
Application.MacroOptions _
Macro:="CleanStr", _
Description:="Remove characters that could interfere with file naming", _
Category:=9, _
ArgumentDescriptions:=Array( _
"=The string to clean", _
"=Replacement characer for bad characters (Default is '-')", _
"=Convert spaces to dashes (TRUE by default)" _
)
End Sub
Sub printASCII()
Dim c, cr As Integer
Dim I
Dim strout As String
'| ASC 032 | ASC 064 @| ASC 096 `| ASC 128 �| ASC 160 �| ASC 192 �| ASC 224 �
'| ASC 033 !| ASC 065 A| ASC 097 a| ASC 129 �| ASC 161 �| ASC 193 �| ASC 225 �
'| ASC 034 "| ASC 066 B| ASC 098 b| ASC 130 �| ASC 162 �| ASC 194 �| ASC 226 �
'| ASC 035 #| ASC 067 C| ASC 099 c| ASC 131 �| ASC 163 �| ASC 195 �| ASC 227 �
'| ASC 036 $| ASC 068 D| ASC 100 d| ASC 132 �| ASC 164 �| ASC 196 �| ASC 228 �
'| ASC 037 %| ASC 069 E| ASC 101 e| ASC 133 �| ASC 165 �| ASC 197 �| ASC 229 �
'| ASC 038 &| ASC 070 F| ASC 102 f| ASC 134 �| ASC 166 �| ASC 198 �| ASC 230 �
'| ASC 039 '| ASC 071 G| ASC 103 g| ASC 135 �| ASC 167 �| ASC 199 �| ASC 231 �
'| ASC 040 (| ASC 072 H| ASC 104 h| ASC 136 �| ASC 168 �| ASC 200 �| ASC 232 �
'| ASC 041 )| ASC 073 I| ASC 105 i| ASC 137 �| ASC 169 �| ASC 201 �| ASC 233 �
'| ASC 042 *| ASC 074 J| ASC 106 j| ASC 138 �| ASC 170 �| ASC 202 �| ASC 234 �
'| ASC 043 +| ASC 075 K| ASC 107 k| ASC 139 �| ASC 171 �| ASC 203 �| ASC 235 �
'| ASC 044 ,| ASC 076 L| ASC 108 l| ASC 140 �| ASC 172 �| ASC 204 �| ASC 236 �
'| ASC 045 -| ASC 077 M| ASC 109 m| ASC 141 �| ASC 173 �| ASC 205 �| ASC 237 �
'| ASC 046 .| ASC 078 N| ASC 110 n| ASC 142 �| ASC 174 �| ASC 206 �| ASC 238 �
'| ASC 047 /| ASC 079 O| ASC 111 o| ASC 143 �| ASC 175 �| ASC 207 �| ASC 239 �
'| ASC 048 0| ASC 080 P| ASC 112 p| ASC 144 �| ASC 176 �| ASC 208 �| ASC 240 �
'| ASC 049 1| ASC 081 Q| ASC 113 q| ASC 145 �| ASC 177 �| ASC 209 �| ASC 241 �
'| ASC 050 2| ASC 082 R| ASC 114 r| ASC 146 �| ASC 178 �| ASC 210 �| ASC 242 �
'| ASC 051 3| ASC 083 S| ASC 115 s| ASC 147 �| ASC 179 �| ASC 211 �| ASC 243 �
'| ASC 052 4| ASC 084 T| ASC 116 t| ASC 148 �| ASC 180 �| ASC 212 �| ASC 244 �
'| ASC 053 5| ASC 085 U| ASC 117 u| ASC 149 �| ASC 181 �| ASC 213 �| ASC 245 �
'| ASC 054 6| ASC 086 V| ASC 118 v| ASC 150 �| ASC 182 �| ASC 214 �| ASC 246 �
'| ASC 055 7| ASC 087 W| ASC 119 w| ASC 151 �| ASC 183 �| ASC 215 �| ASC 247 �
'| ASC 056 8| ASC 088 X| ASC 120 x| ASC 152 �|| ASC 184 �| ASC 216 �| ASC 248 �
'| ASC 057 9| ASC 089 Y| ASC 121 y| ASC 153 �| ASC 185 �| ASC 217 �| ASC 249 �
'| ASC 058 :| ASC 090 Z| ASC 122 z| ASC 154 �| ASC 186 �| ASC 218 �| ASC 250 �
'| ASC 059 ;| ASC 091 [| ASC 123 {| ASC 155 �| ASC 187 �| ASC 219 �| ASC 251 �
'| ASC 060 <| ASC 092 \| ASC 124 || ASC 156 �| ASC 188 �| ASC 220 �| ASC 252 �
'| ASC 061 =| ASC 093 ]| ASC 125 }| ASC 157 �| ASC 189 �| ASC 221 �| ASC 253 �
'| ASC 062 >| ASC 094 ^| ASC 126 ~| ASC 158 �| ASC 190 �| ASC 222 �| ASC 254 �
'| ASC 063 ?| ASC 095 _| ASC 127 | ASC 159 �| ASC 191 �| ASC 223 �
'| ASC 064 @| ASC 096 `| ASC 128 �| ASC 160 �| ASC 192 �| ASC 224 �
c = 8 ''cols
cr = 256 / c ''col gap
For I = 0 To cr
strout = "'"
For J = 1 To c
If I + J * cr < 255 Then
strout = strout & "| ASC " & (Right("000" & Trim(Str(I + J * cr)), 3)) & " " & Chr(I + J * cr)
End If
Next J
Debug.Print strout
Next I
End Sub
Next I
Comments
Post a Comment