Office右键菜单中添加Google或Baidu搜索

juncox

在word中选中文字，点击右键，菜单里面有个google搜索功能，点击后可直接启动当前默认浏览器对选中的文字进行搜索。
4 {, p. l4 F8 K7 S! [. `
具体在工具->宏->VB编辑器中打开，把下面的文字插入到Normal模板的模块中，重新运行就会出现搜索菜单了。

6 U3 d7 t2 C& i4 l3 S1 ?
'功能简介: 在右键文本菜单的第一项, 添加一个Google和Baidu搜索命令
'Creator: Juncox,
'Email:   Juncox@163.com
0 g% n- ]# O6 y9 \'----------------------
) F1 g/ C+ {1 W3 L  rPrivate Sub Document_Close()
    On Error Resume Next
0 Z) |  {& W8 K* m& j    Application.CommandBars("Text").Controls("Google搜索").Delete   '恢复原有菜单
# E8 a3 b* n8 Q* V5 F. a" J) O7 Q    Application.CommandBars("Text").Controls("Baidu搜索").Delete   '恢复原有菜单
0 T; B& h9 X3 n7 K- ?# F+ u: P    Application.CommandBars("Text").Reset '重新设置右键菜单,彻底恢复默认设置
End Sub
# G  j; ?+ C9 ^; d6 k) c0 @! ~1 J
'----------------------
Private Sub Document_Open()
% }2 n. L' \( C6 |    On Error Resume Next
, M) ^6 k& k& ?! n0 A7 L    Dim BtnGoogle As CommandBarButton
3 t4 T5 z- H$ J$ h9 h# B0 k    Dim BtnBaidu As CommandBarButton
    Application.CommandBars("Text").Controls("Google搜索").Delete   '预防性删除
    Application.CommandBars("Text").Controls("Baidu搜索").Delete   '预防性删除
    Application.CommandBars("Text").Reset '重新设置右键菜单,彻底恢复默认设置
    Set BtnGoogle = Application.CommandBars("Text").Controls.Add(Type:=msoControlButton, Before:=1) '第一项
  W* p+ q- T% J$ l+ X$ w    Set BtnBaidu = Application.CommandBars("Text").Controls.Add(Type:=msoControlButton, Before:=2) '第二项
- U, f" A* Y6 \7 {6 j' C; A: H    With BtnGoogle
& R% s4 k* g, r+ x6 l2 w3 C      .Caption = "&Google搜索" '命令名称
8 u/ ]4 A. d! a# q0 _5 s- i4 n      .FaceId = 86             '命令的FaceId，字母G
      .Visible = True           '可见
: T  F: S8 O6 f2 X      .OnAction = "GoogleSearch"       '指定响应过程名
1 h2 P4 d, p. v1 @    End With
# Q# k5 ]+ m% ]$ j4 g% B( W1 D    With BtnBaidu
      .Caption = "&Baidu搜索" '命令名称
& p+ [7 e  p' v8 u2 r      .FaceId = 81             '命令的FaceId
      .Visible = True           '可见
% W' Z7 T" S# ~  }* l) [5 y      .OnAction = "BaiduSearch"       '指定响应过程名
& ~) r8 y0 Q* R3 f5 c    End With
End Sub

'----------------------
Sub GoogleSearch()
    Dim sSearch$, sSel$
    sSel = Trim(Selection.Text)
    'If Len(sSel) <= 1 Then
7 ^1 [$ O8 `- y) w& |    '  MsgBox "选择的文本太少，不能进行搜索！" & vbCrLf & "最少两个字符！！！ Juncox@163.com", vbInformation + vbOKOnly, "Google搜索"
! [3 p8 Y- N$ I) M! M$ b! C    'Else
      sSearch = "explorer ""http://www.google.cn/search?client=Juncox&hl=zh-CN&q=" & sSel & """"    '两种形式结果是一致的
2 P% Y2 m8 u4 @1 r/ p4 a  F3 p      sSearch = "explorer " & Chr(34) & "http://www.google.cn/search?client=Juncox&hl=zh-CN&q=" & sSel & Chr(34)
  R% w5 P# O" i" N+ @, |      Shell sSearch
    'End If
* @1 p& S4 }" F/ j( H2 H2 X$ qEnd Sub

1 s1 ?6 f$ ?, i8 b8 `" g2 h  {, OSub BaiduSearch()
    Dim sSearch$, sSel$
7 `- d7 x5 }# t) R* v0 e5 y6 j    sSel = Trim(Selection.Text)
( r; W  I0 L) q0 p9 l$ _9 ]% y    'If Len(sSel) <= 1 Then
0 t$ f- C5 g8 ^; T  N! i    '  MsgBox "选择的文本太少，不能进行搜索！" & vbCrLf & "最少两个字符！！！ Juncox@163.com", vbInformation + vbOKOnly, "Google搜索"
* ]1 ?5 f5 j5 W( r4 k) H( M  B    'Else
      sSearch = "explorer ""http://www.baidu.com/baidu?tn=Juncox&word=" & sSel & """"
      sSearch = "explorer " & Chr(34) & "http://www.baidu.com/baidu?tn=Juncox&word=" & sSel & Chr(34)
      Shell sSearch
* {6 |. a* m; e9 b# l    'End If
' }8 J0 G3 h; d7 BEnd Sub