插入一个图片时，怎样禁止用户拖动图片的大小但却可以拖动图片的位置

mrsxw2004

用ActiveDocument.Shapes.AddPicture加入一个图片时，怎样禁止用户拖动图片的大小但却可以拖动图片的位置，我用的这个方式加入的图片：

ActiveDocument.Shapes.AddPicture filepsthstr, False, True ActiveDocument.Shapes(ActiveDocument.Shapes.Count).Select Selection.ShapeRange.WrapFormat.Type = 3 Selection.ShapeRange.PictureFormat.TransparentBackground = True Selection.ShapeRange.PictureFormat.TransparencyColor = 16777215 Selection.ShapeRange.Fill.Visible = False

mrsxw2004

呜呜，没有办法吗

守柔

我想办法还是有的，不过可以分几种情况对待：

比如，一旦选定内容改变后，恢复原来的图片尺寸（需要使用类模块）

二是，是否可以考虑使用IMAGE控件加载图片呢？

mrsxw2004

我觉的第一种情况比较可行，可如何做这个事件控制呢，我对word的事件处理不太熟悉

henterwu

试试这样行不行：

选中图片时记录下SIZE，失去焦点是 .RESET（恢复原尺寸）。

[此贴子已经被作者于2005-5-18 20:30:52编辑过]

守柔

简单地做了一个,请楼主用后再说:

LQkngFJM.rar (14.89 KB, 下载次数: 64)

2005-5-18 21:06 上传

点击文件名下载附件
插入一个图片时，怎样禁止用户拖动图片的大小但却可以拖动图片的位置

mrsxw2004

守柔我无法下载，能不能把代码贴到网页上，或者将附件发到mrsxw2004@yahoo.com.cn

守柔

以下是引用mrsxw2004在2005-5-19 9:18:00的发言：

守柔我无法下载，能不能把代码贴到网页上，或者将附件发到mrsxw2004@yahoo.com.cn

以下代码供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-5-19 10:54:25 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Dim X As New EventClassModule Private Sub Document_Open() Set X.App = Word.Application End Sub '---------------------- Sub Example() Me.Shapes(1).Name = "Test" End Sub '---------------------- '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-5-19 10:54:33 '仅测试于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 ActiveDocument.Shapes.Count > 0 Then If Sel.Type <> wdSelectionShape Then With ActiveDocument.Shapes("Test") If .Width <> 100 Then App.ScreenUpdating = False: .Width = 100 If .Height <> 100 Then App.ScreenUpdating = False: .Height = 100 End With End If App.ScreenUpdating = True ' If Sel.Type = wdSelectionShape Then ' If Sel.ShapeRange(1).Name = "Test" Then ActiveDocument.Range(0, 0).Select ' End If End If End Sub '---------------------- 注意，原图片的格式设置中，应去除对锁定纵横比和相对于原始图片大小二个选项。

mrsxw2004

守柔，这样对单个文档可以，但是要把这个功能做成模版，就不行了，我试过，因为在模版中做这个功能，ThisDocument中加这个代码，就只对模版本身有效，对调用模版的文档是无效的

Dim X As New EventClassModule Private Sub Document_Open() Set X.App = Word.Application End Sub 这个事件就没有办法执行，类就不能初始化，

守柔

以下是引用mrsxw2004在2005-5-23 14:20:00的发言：

守柔，这样对单个文档可以，但是要把这个功能做成模版，就不行了，我试过，因为在模版中做这个功能，ThisDocument中加这个代码，就只对模版本身有效，对调用模版的文档是无效的

Dim X As New EventClassModule Private Sub Document_Open() Set X.App = Word.Application End Sub 这个事件就没有办法执行，类就不能初始化，

看来楼主对于WORD的模板还是缺乏了解.

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-5-24 20:12:58 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Dim X As New EventClassModule Private Sub Document_New() Set X.App = Word.Application End Sub '---------------------- Private Sub Document_Open() Set X.App = Word.Application End Sub '---------------------- Sub Example() Me.Shapes(1).Name = "Test" End Sub '----------------------类模块略.