以下代码,供网友参考:(关程序关键是使用了Spreadsheet1 10.0控件,并设置了定义名称) 如果是WORD2000因为只有Spreadsheet1 9.0,可能会出现问题) Private Sub Document_Close()
ResetControls
End Sub Private Sub Document_Open()
Dim MyBar As CommandBarControl
Set MyBar = Application.CommandBars("Text").Controls.Add(Type:=msoControlButton)
With MyBar
.Visible = True
.Caption = "CallMe"
.OnAction = "ShowMe"
.FaceId = 209
End With
End Sub
Sub ShowMe()
UserForm1.Show 0
End Sub
Sub ResetControls()
Application.CommandBars("Text").Reset
End Sub Private Sub Spreadsheet1_SelectionChange()
Dim MyValue As Byte
With Me.Spreadsheet1
If .ActiveCell.Address <> .Selection.Address Then
MyValue = MsgBox("是否需要插入" & Me.Caption & "表格中的选定部分,按OK插入,按Cancel取消!", vbOKCancel + vbInformation + vbDefaultButton2)
If MyValue = vbCancel Then
Exit Sub
Else
.Selection.Copy
Selection.Collapse Direction:=wdCollapseEnd
Selection.Paste
End If
Else
Selection.InsertAfter Me.Spreadsheet1.ActiveCell.Value
Selection.EndKey unit:=wdLine
Me.Caption = .ActiveCell.CurrentRegion.Cells(1).Value & "地价表"
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim i As Name, MyString As String
MyString = Selection.Text
For Each i In Me.Spreadsheet1.Names
If i.Name = MyString Then
Me.Caption = i.Name & "地价表"
Me.Spreadsheet1.Sheets(1).Activate
Me.Spreadsheet1.Range(i.Name).Select
Exit Sub
End If
Next
Me.Spreadsheet1.Sheets(1).Activate
Me.Caption = "未指定的地价"
End Sub
|