vba - 仅允许 ascii 字符 VBA

Question

我想从 powerpoint 中获取一些文本以在其他软件中使用。但是这个软件只支持 ASCII 字符（没有扩展的 ASCII）。如何删除非 ASCII 字符？有什么方法可以在 VBA 中做到这一点吗？

Answer 1

在我们的 Access VBA 代码中，我们使用 2 个函数将 Extended Latin 转换为 ASCII，希望对 VBA Power Point 有效：

I. chrRemoveAccents() 删除字符的重音，

二、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"