아스키 문자 만 허용 VBA

다른 소프트웨어에서 사용하기 위해 파워 포인트의 일부 텍스트를 가져 가고 싶습니다. 그러나이 소프트웨어는 ASCII 문자 (확장 ASCII 없음) 만 지원합니다. ASCII가 아닌 문자를 제거하려면 어떻게해야합니까? VBA에서 그걸 만들 수있는 방법이 있습니까? ,아스키 문자 만 허용 VBA

I. chrRemoveAccents() 문자에서 악센트를 제거

II를 : 우리의 액세스 VBA 코드에서

출처

2013-10-22 Iban Arriola

당신은 텍스트/문자 반복 및 범위를 벗어 인'Chr' 값을 확인해야합니다 당신의 문자 집합. 이를 구현하는 데 특정 문제가있는 경우 지금까지 시도한 코드와 실패한 코드를 게시하십시오. –

아마도 여기에서 찾을 수있는 RegEx ... 예제를 많이 사용할 수 있습니다. –

, 우리는 VBA 파워 포인트에 대한 작동 ASCII, 희망에 라틴어 확장 변환이 functiions를 사용 . strRemoveAccents()는 chrRemoveAccents()를 사용하여 문자열에서 악센트를 제거합니다.

Function chrRemoveAccents(ByVal c1) 
    Dim iCode As Long 
    iCode = AscW(c1) 
' 
    Select Case iCode 
' 
' À = 192; Á = 193; Â = 194; Ã = 195; Ä = 196; Å = 197; 
' 
    Case 192 To 197 
     chrRemoveAccents = "A" 
' 
' Æ = 198; 
' 
    Case 198 
     chrRemoveAccents = "AE" 
' 
' Ç = 199; 
' 
    Case 199 
     chrRemoveAccents = "C" 
' 
' È = 200; É = 201; Ê = 202; Ë = 203; 
' 
    Case 200 To 203 
     chrRemoveAccents = "E" 
' 
' Ì = 204; Í = 205; Î = 206; Ï = 207; 
' 
    Case 204 To 207 
     chrRemoveAccents = "I" 
' 
' Ð = 208; 
' 
    Case 208 
     chrRemoveAccents = "D" 
' 
' Ñ = 209; 
' 
    Case 209 
     chrRemoveAccents = "N" 
' 
' Ò = 210; Ó = 211; Ô = 212; Õ = 213; Ö = 214; Ø = 216; 
' 
    Case 210 To 216 
     chrRemoveAccents = "O" 
' 
' Ù = 217; Ú = 218; Û = 219; Ü = 220; 
' 
    Case 217 To 220 
     chrRemoveAccents = "U" 
' 
' Ý = 221; Ÿ = 376; 
' 
    Case 221, 376 
     chrRemoveAccents = "Y" 
' 
' Œ = 338; 
' 
    Case 338 
     chrRemoveAccents = "OE" 
' 
' Š = 352; 
' 
    Case 352 
     chrRemoveAccents = "S" 
' 
' 
' à=224, á = 225; â = 226; ã = 227; ä = 228; å = 229; 
' 
    Case 224 To 229 
     chrRemoveAccents = "a" 
' 
' æ = 230; 
' 
    Case 230 
     chrRemoveAccents = "ae" 
' 
' ç = 231; 
' 
    Case 231 
     chrRemoveAccents = "c" 
' 
' è = 232; é = 233; ê = 234; ë = 235; 
' 
    Case 232 To 235 
     chrRemoveAccents = "e" 
' 
' ì = 236; í = 237; î = 238; ï = 239; 
' 
    Case 236 To 239 
     chrRemoveAccents = "i" 
' 
' ð = 240; 
' 
    Case 240 
     chrRemoveAccents = "d" 
' 
' ñ = 241; 
' 
    Case 241 
     chrRemoveAccents = "n" 
' 
' ò = 242; ó = 243; ô = 244; õ = 245; ö = 246; 
' 
    Case 242 To 246 
     chrRemoveAccents = "o" 
' 
' ù = 249; ú = 250; û = 251; ü = 252; 
' 
    Case 249 To 252 
     chrRemoveAccents = "u" 
' 
' ý = 253; ÿ = 255; 
' 
    Case 253, 255 
     chrRemoveAccents = "y" 
' 
' œ = 339; 
' 
    Case 339 
     chrRemoveAccents = "oe" 
' 
' š = 353; 
' 
    Case 353 
     chrRemoveAccents = "s" 
' 
    Case Else 
     chrRemoveAccents = c1 
    End Select 
End Function 

Function strRemoveAccents(ByVal varIn) 
    Dim i As Long, lng As Long 
' 
    Dim str1 As String 
    str1 = "" 
' 
    If (Not IsNull(varIn)) Then 
' 
    lng = Len(varIn) 
' 
    For i = 1 To lng 
     str1 = str1 & chrRemoveAccents(Mid(varIn, i, 1)) 
    Next 
' 
    End If 
' 
    strRemoveAccents = str1 
End Function

전화는 :

strAscii = strRemoveAccents("écolière")

제공합니다 :

strAscii = "ecoliere"

출처

2013-10-22 20:57:40 jacouh

아스키 문자 만 허용 VBA

답변

관련 문제