- Sub Google()
- '
- ' Google Macro
- ' Macro enregistrée le 21/02/2008 par VBsnail
- Dim Utf8 As String
- TexteSelectionne = ""
- Text = Selection.Text
- i = 1
- For i = 1 To Len(Text)
- car = Mid(Text, i, 1)
- TexteSelectionne = TexteSelectionne + EncodeUTF8(car)
- Next i
- 'debug MsgBox (TexteSelectionne)
-
- ' %22 c'est le guillement " à mettre en début et en fin de chaîne pour forcer la recherche Google sur la chaîne entière
- URL = "http://www.google.com/search?q=%22" & TexteSelectionne & "%22"
- ' MsgBox (Len(URL))
- ' Attention, si la longueur dépassse 487, l'url transmise est tronquée.
- ' Limitation liée à la taille de l'URL que Word accepte d'associer au texte. A éclaircir
- ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
- URL, SubAddress:="", ScreenTip:="", _
- TextToDisplay:=Selection.Text
- End Sub
-
- Public Function EncodeUTF8(ByVal car As String) As String
- CarVal = AscW(car)
- If CarVal < 0 Then CarVal = CarVal + 65536
- 'Ce IF, c'est pour éviter d'avoir un nombre négatif pour un code point >7fff
- If CarVal < 128 Then 'Cas ASCII, codage sur 1 octet, 7 bits significatifs
- EncodeUTF8 = car
- Exit Function
- End If
- If CarVal < 2048 Then 'Cas du codage sur 2 octets, de 8 à 11 bits significatifs (5 bits puis 6 bits)
- Sextet = 128 + CarVal Mod 64
- CarVal = CarVal \ 64
- Quintet = 192 + CarVal
- EncodeUTF8 = "%" + Hex(Quintet) + "%" + Hex(Sextet)
- Exit Function
- End If
- 'cas du codage sur 3 octets, de 12 à 16 bits significatifs, (4 bits, 6 bits, 6bits)
- Sextet2 = 128 + CarVal Mod 64
- CarVal = CarVal \ 64
- Sextet1 = 128 + CarVal Mod 64
- CarVal = CarVal \ 64
- Quartet = 224 + CarVal
- EncodeUTF8 = "%" + Hex(Quartet) + "%" + Hex(Sextet1) + "%" + Hex(Sextet2)
- ' A ma connaisssnace, Windows ne gère pas de caractères Unicode au déla de U+FFFD, représenté par un rectangle vide
- ' de toutes façons, l'Unicode est codé sur 2 octets !!!
- ' Il n'est donc pas nécessaire de prévoir le cas du codage sur 4 octets
- End Function
Sub Google()
'
' Google Macro
' Macro enregistrée le 21/02/2008 par VBsnail
Dim Utf8 As String
TexteSelectionne = ""
Text = Selection.Text
i = 1
For i = 1 To Len(Text)
car = Mid(Text, i, 1)
TexteSelectionne = TexteSelectionne + EncodeUTF8(car)
Next i
'debug MsgBox (TexteSelectionne)
' %22 c'est le guillement " à mettre en début et en fin de chaîne pour forcer la recherche Google sur la chaîne entière
URL = "http://www.google.com/search?q=%22" & TexteSelectionne & "%22"
' MsgBox (Len(URL))
' Attention, si la longueur dépassse 487, l'url transmise est tronquée.
' Limitation liée à la taille de l'URL que Word accepte d'associer au texte. A éclaircir
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
URL, SubAddress:="", ScreenTip:="", _
TextToDisplay:=Selection.Text
End Sub
Public Function EncodeUTF8(ByVal car As String) As String
CarVal = AscW(car)
If CarVal < 0 Then CarVal = CarVal + 65536
'Ce IF, c'est pour éviter d'avoir un nombre négatif pour un code point >7fff
If CarVal < 128 Then 'Cas ASCII, codage sur 1 octet, 7 bits significatifs
EncodeUTF8 = car
Exit Function
End If
If CarVal < 2048 Then 'Cas du codage sur 2 octets, de 8 à 11 bits significatifs (5 bits puis 6 bits)
Sextet = 128 + CarVal Mod 64
CarVal = CarVal \ 64
Quintet = 192 + CarVal
EncodeUTF8 = "%" + Hex(Quintet) + "%" + Hex(Sextet)
Exit Function
End If
'cas du codage sur 3 octets, de 12 à 16 bits significatifs, (4 bits, 6 bits, 6bits)
Sextet2 = 128 + CarVal Mod 64
CarVal = CarVal \ 64
Sextet1 = 128 + CarVal Mod 64
CarVal = CarVal \ 64
Quartet = 224 + CarVal
EncodeUTF8 = "%" + Hex(Quartet) + "%" + Hex(Sextet1) + "%" + Hex(Sextet2)
' A ma connaisssnace, Windows ne gère pas de caractères Unicode au déla de U+FFFD, représenté par un rectangle vide
' de toutes façons, l'Unicode est codé sur 2 octets !!!
' Il n'est donc pas nécessaire de prévoir le cas du codage sur 4 octets
End Function