|
最近比较忙，见楼主一而再，再而三的重复求助和发贴，有些不悦。
以下代码供大家参考 '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2001-2-24 5:27:31
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'№ 00072^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub InsertShape()
Dim LeftPostion As Single, TopPostion As Single, myShape As Shape
Dim KeyCon As String
'返回当前命令按钮的Caption属性
KeyCon = Application.CommandBars.ActionControl.Caption
With Selection
'如果光标位置不是插入点状态,则退出(无论选定了文本,图形还是其它)
If .Type <> wdSelectionIP Then Exit Sub
On Error Resume Next '忽略错误
Application.ScreenUpdating = False '关闭屏幕更新
'取得光标所在的左边距
LeftPostion = .Information(wdHorizontalPositionRelativeToPage)
'取得光标所在的上边距
TopPostion = .Information(wdVerticalPositionRelativeToPage)
'向光标处插入指定的带格式的自动图文集内容
ActiveDocument.AttachedTemplate.AutoTextEntries(KeyCon).Insert .Range, True
'定义一个SHAPE对象,始终是文档最后一个SHAPE索引
Set myShape = ActiveDocument.Shapes(ActiveDocument.Shapes.Count)
With myShape
'设置SHAPE对象的水平相对位置为页面
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
'设置SHAPE对象的垂直相对位置为页面
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Left = LeftPostion '设置左边距
.Top = TopPostion '设置右边距
End With
End With
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
'----------------------
Sub AddControl()
Dim myButton As CommandBarButton, myString() As Variant, i As Byte
myString = Array("秘印章", "禁印章", "限印章", "绝印章")
For i = 1 To 4
Application.CustomizationContext = ActiveDocument.AttachedTemplate
Set myButton = Application.CommandBars("Menu Bar").Controls("粘印章(&P)").Controls.Add
With myButton
.Caption = myString(i - 1)
.OnAction = "InsertShape"
End With
Next
End Sub
'----------------------
操作方法，无论直接打开该模板（右击：打开）或者以此模板新建（双击打开）等，均在当前文档最右侧的菜单栏中有一个"粘印章(P)"命令，单击此命令，可展开子菜单，选择任一命令，可向当前文档光标所有位置插入指定的印章。
注意：必须在宏安全性为低的条件下；
光标位置，光标状态只限于插入点状态，任意选定文本、符号、图形、表格等将不会插入印章。
96tFJsTM.rar
(11.22 KB, 下载次数: 59)
[此贴子已经被作者于2005-10-29 5:42:37编辑过] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-10-28 09:03
楼主