|
y6Y2Fq3y.zip
(17.87 KB, 下载次数: 20)
有两个问题，未能解决！
一是切换到另一个窗口时，工具栏的闪动；
二是不知为何，切换到另一窗口时，COMBOX的值有问题，见 ObjChange过程。
我与BUTTON用的是两种方法（但大同小异），希望有空交流一下。
代码如下：
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-2-10 15:12:51
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [标准模块-模块1]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Public objComb As CommandBarComboBox, SelPageItem As Integer
Dim X As New EventClassModule
Sub AutoExec()
Set X.App = Word.Application
SelPageItem = Selection.Information(wdActiveEndPageNumber)
AddPsBar
End Sub
'----------------------
Sub AddPsBar() '添加菜单
Dim SelPageBar As CommandBar, cmdToStart As CommandBarButton, cmdPreview As CommandBarButton
Dim cmdNext As CommandBarButton, cmdToEnd As CommandBarButton
Dim cmdAbout As CommandBarButton, cmdClose As CommandBarButton
On Error Resume Next
' Application.CustomizationContext = ActiveDocument
Application.CommandBars("Page_Select").Delete
Set SelPageBar = Application.CommandBars.Add(Name:="Page_Select", Position:=msoBarTop, Temporary:=True)
Set cmdToStart = SelPageBar.Controls.Add(Before:=1)
With cmdToStart
.Caption = "第一页"
.FaceId = 154
.BeginGroup = True
.OnAction = "GoToSelPage"
End With
Set cmdPreview = SelPageBar.Controls.Add(Before:=2)
With cmdPreview
.Caption = "上一页"
.FaceId = 155
.OnAction = "GoToSelPage"
End With
Set objComb = SelPageBar.Controls.Add(Type:=msoControlComboBox, ID:=1, Before:=3)
With objComb
.Width = 70
.Style = msoComboLabel
ShowPages
.OnAction = "ObjChange"
End With
Set cmdNext = SelPageBar.Controls.Add(Before:=4)
With cmdNext
.Caption = "下一页"
.FaceId = 156
.BeginGroup = True
.OnAction = "GoToSelPage"
End With
Set cmdToEnd = SelPageBar.Controls.Add(Type:=msoControlButton, Before:=5)
With cmdToEnd
.Caption = "最后一页"
.FaceId = 157
.OnAction = "GoToSelPage"
End With
Set cmdAbout = SelPageBar.Controls.Add(Type:=msoControlButton, Before:=6)
With cmdAbout
.Caption = "关于"
.FaceId = 984
.BeginGroup = True
.OnAction = "GoToSelPage"
End With
Set cmdClose = SelPageBar.Controls.Add(Type:=msoControlButton, Before:=7)
With cmdClose
.Caption = "关闭"
.FaceId = 840
.BeginGroup = True
.OnAction = "GoToSelPage"
End With
SelPageBar.Visible = True
ShowPages
End Sub
'----------------------
Sub GoToSelPage()
' ShowPages
With Selection
Select Case Application.CommandBars.ActionControl.Caption
Case "第一页"
.GoTo wdGoToPage, , , 1
Case "上一页"
.GoToPrevious wdGoToPage
Case "下一页"
.GoToNext wdGoToPage
Case "最后一页"
.GoTo wdGoToPage, , , .Information(wdNumberOfPagesInDocument)
Case "关于"
MsgBox "Product of Button" & Chr(13) & Chr(13) _
& "欢迎使用快速选择指定页工具!" & Chr(13) _
& "请多多指正!" & Chr(13) & Chr(13) _
& "作者:Button" & Chr(13) _
& "Version:Demo" & Chr(13) _
& "发布日期:2004-6", vbOKOnly, "Free Tools for Excel—Page Select"
Case "关闭"
On Error Resume Next
Application.CommandBars("Page_Select").Delete
End Select
End With
End Sub
'----------------------
Sub ShowPages() '在COMBOX显示页码
On Error Resume Next
Dim PageItem As Integer
Application.ScreenUpdating = False
With objComb
.Clear
For PageItem = 1 To Selection.Information(wdNumberOfPagesInDocument)
.AddItem "第 " & PageItem & " 页", PageItem
Next PageItem
.ListIndex = Selection.Information(wdActiveEndPageNumber)
End With
Application.ScreenUpdating = True
End Sub
'----------------------
Sub ObjChange()
Dim ItemPage As Integer, ObjText As String, I As Integer, N As Integer
On Error Resume Next
If objComb.Text = "" Then Exit Sub
ObjText = objComb.Text
MsgBox ObjText & "ObjText"'此处有问题!即变化窗口后的值没有及时改变!
If ObjText Like "第 #* 页" = True Then
ItemPage = Mid(ObjText, 2, Len(ObjText) - 2) * 1
MsgBox ItemPage & "第"
ElseIf ObjText Like "#*" = True Then
For I = 1 To Len(ObjText)
If Asc(Mid(ObjText, I, 1)) < 48 Or Asc(Mid(ObjText, I, 1)) > 57 Then N = N + 1
Next
If N > 0 Then
MsgBox "无效数据", vbExclamation, "Warnning!"
Else
ItemPage = ObjText * 1
If ItemPage > Selection.Information(wdNumberOfPagesInDocument) Then _
MsgBox "无效数据", vbExclamation, "Warnning!": Exit Sub
End If
End If
Selection.GoTo wdGoToPage, , , ItemPage
End Sub
'----------------------
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-2-10 15:13:08
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [类模块-EventClassModule]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Public WithEvents App As Word.Application
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
If Sel.Information(wdActiveEndPageNumber) <> SelPageItem Then
ShowPages
SelPageItem = Sel.Information(wdActiveEndPageNumber)
End If
End Sub
'----------------------
Private Sub App_DocumentChange()
ShowPages
End Sub
'---------------------- | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-2-4 16:23
楼主