Function Contient(m$, p$)
Dim i&, j&, n&, c$
m = LCase(PrOut(m))
p = LCase(PrOut(p))
For i = 1 To Len(p)
c = Mid$(p, i, 1)
For j = 1 To Len(m)
If c = Mid$(m, j, 1) Then n = n + 1: Exit For
Next
Next
Contient = n = Len(p)
End Function
Function PrOut(m$)
Dim i&, c$
For i = 1 To Len(m)
c = Mid$(m, i, 1)
'
Select Case Asc(c)
'
Case 138: c = Chr(83) 'Š -> S
Case 140: c = Chr(79) & Chr(69) 'Œ -> OE
Case 142: c = Chr(90) 'Ž -> Z
Case 154: c = Chr(115) 'š -> s
Case 156: c = Chr(111) & Chr(101) 'œ -> oe
Case 158: c = Chr(122) 'ž -> z
Case 159: c = Chr(89) 'Ÿ -> Y
Case 170: c = Chr(97) 'ª -> a
Case 192 To 197: c = Chr(65) 'À... -> A
Case 198: c = Chr(65) & Chr(69) 'Æ -> AE
Case 199: c = Chr(67) 'Ç -> C
Case 200 To 203: c = Chr(69) 'È... -> E
Case 204 To 207: c = Chr(73) 'Ì... -> I
Case 210 To 214: c = Chr(79) 'Ò... -> O
Case 217 To 220: c = Chr(85) 'Ù... -> U
Case 221: c = Chr(89) 'Ý -> Y
Case 224 To 229: c = Chr(97) 'à -> a
Case 230: c = Chr(97) & Chr(101) 'æ -> ae
Case 231: c = Chr(99) 'ç -> c
Case 232 To 235: c = Chr(101) 'è... -> e
Case 236 To 239: c = Chr(105) 'ì... -> i
Case 242 To 246: c = Chr(111) 'ò... -> o
Case 249 To 252: c = Chr(117) 'ù... -> u
Case 253, 255: c = Chr(121) 'ý... -> y
End Select
'
PrOut = PrOut & c
Next
End Function