查阅资料后,我自己可以实现Word里用VC代码画线的功能,但实际的需求是需要用户按鼠标左键、移动鼠标画线。
找不到思路啦...求助坛子里的各位,谢谢!
7 个解决方案
#1
说明一下,结帖率0%我想是因为我第一次提问吧,大家不要被吓倒啦。
#2
没有了解过这块,帮顶
#3
在Word2003中开始记录宏,手动完成所需功能,结束记录宏,按Alt+F11键,查看刚才记录的宏对应的VBA代码。
#4
谢谢zhao4zhong1的回复,
之前是有做过宏记录的,内容如下:
Sub dl1()
'
' dl1 Macro
' 宏在 2013-6-25 由 User 录制
'
With ActiveDocument.Shapes.BuildFreeform(msoEditingCorner, 81.75, 102.75)
.AddNodes msoSegmentCurve, msoEditingCorner, 82.85, 97.2, 84.2, _
96.4, 87.75, 92.25
.AddNodes msoSegmentCurve, msoEditingCorner, 88.35, 91.55, 88.55, _
90.6, 89.25, 90#
.AddNodes msoSegmentCurve, msoEditingCorner, 90.35, 89.05, 91.85, _
88.6, 93#, 87.75
.AddNodes msoSegmentCurve, msoEditingCorner, 93.85, 87.1, 94.3, _
86#, 95.25, 85.5
.AddNodes msoSegmentCurve, msoEditingCorner, 97.6, 84.2, 100.35, _
83.7, 102.75, 82.5
.AddNodes msoSegmentCurve, msoEditingCorner, 105.05, 83.05, 106.25, _
83#, 108#, 84.75
.AddNodes msoSegmentCurve, msoEditingCorner, 108.65, 85.4, 108.85, _
86.35, 109.5, 87#
.AddNodes msoSegmentCurve, msoEditingCorner, 110.15, 87.65, 111.1, _
87.85, 111.75, 88.5
.AddNodes msoSegmentCurve, msoEditingCorner, 115.45, 92.2, 118.8, _
96.35, 120.75, 101.25
.AddNodes msoSegmentCurve, msoEditingCorner, 124.05, 109.45, 120.2, _
100.85, 124.5, 108#
.AddNodes msoSegmentCurve, msoEditingCorner, 124.65, 108.2, 124.5, _
108.5, 124.5, 108.75
.ConvertToShape.Select
End With
End Sub
目前是已经实现了程序画线的功能,现在是要在Word下捕获、响应鼠标后画线,能做到类似Word绘图的效果。
之前是有做过宏记录的,内容如下:
Sub dl1()
'
' dl1 Macro
' 宏在 2013-6-25 由 User 录制
'
With ActiveDocument.Shapes.BuildFreeform(msoEditingCorner, 81.75, 102.75)
.AddNodes msoSegmentCurve, msoEditingCorner, 82.85, 97.2, 84.2, _
96.4, 87.75, 92.25
.AddNodes msoSegmentCurve, msoEditingCorner, 88.35, 91.55, 88.55, _
90.6, 89.25, 90#
.AddNodes msoSegmentCurve, msoEditingCorner, 90.35, 89.05, 91.85, _
88.6, 93#, 87.75
.AddNodes msoSegmentCurve, msoEditingCorner, 93.85, 87.1, 94.3, _
86#, 95.25, 85.5
.AddNodes msoSegmentCurve, msoEditingCorner, 97.6, 84.2, 100.35, _
83.7, 102.75, 82.5
.AddNodes msoSegmentCurve, msoEditingCorner, 105.05, 83.05, 106.25, _
83#, 108#, 84.75
.AddNodes msoSegmentCurve, msoEditingCorner, 108.65, 85.4, 108.85, _
86.35, 109.5, 87#
.AddNodes msoSegmentCurve, msoEditingCorner, 110.15, 87.65, 111.1, _
87.85, 111.75, 88.5
.AddNodes msoSegmentCurve, msoEditingCorner, 115.45, 92.2, 118.8, _
96.35, 120.75, 101.25
.AddNodes msoSegmentCurve, msoEditingCorner, 124.05, 109.45, 120.2, _
100.85, 124.5, 108#
.AddNodes msoSegmentCurve, msoEditingCorner, 124.65, 108.2, 124.5, _
108.5, 124.5, 108.75
.ConvertToShape.Select
End With
End Sub
目前是已经实现了程序画线的功能,现在是要在Word下捕获、响应鼠标后画线,能做到类似Word绘图的效果。
#5
Sub File()'Word.EventClassModule-------------------------------------------------------------------
End Sub
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "EventClassModule"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public WithEvents App As Application
Attribute App.VB_VarHelpID = -1
Public WithEvents BtnPen As CommandBarButton
Attribute BtnPen.VB_VarHelpID = -1
Public JustPen As Boolean
Public WithEvents BtnSelect As CommandBarButton
Attribute BtnSelect.VB_VarHelpID = -1
Public JustSelect As Boolean
Public BtnPenClickTime As Single
Public BtnPenDblClick As Boolean
Public BtnPenPressed As Boolean
Public BtnPenExecuted As Boolean
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
' Debug.Print "App_WindowSelectionChange(Sel.Type=" + CStr(Sel.Type) + ",Sel.Text=" + Sel.Text + ")"
' Debug.Print "BtnPen.State="; BtnPen.State
' Debug.Print "JustPen=" + CStr(JustPen)
' Debug.Print "BtnSelect.State="; BtnSelect.State
' Debug.Print "JustSelect=" + CStr(JustSelect)
If BtnPenPressed Then
Sel.Start = Sel.Start: Sel.End = Sel.End '消除当前图形对象上的选择框
' Debug.Print "Execute Again"
BtnPenExecuted = True
App.CommandBars("笔相关").Controls("笔").Execute
Exit Sub
End If
If Sel.Type = wdSelectionShape Then
If Not (BtnSelect.State = msoButtonDown Or JustSelect) Then
Sel.Start = Sel.Start: Sel.End = Sel.End '消除当前图形对象上的选择框
End If
Else
JustSelect = False
End If
JustPen = False
End Sub
Private Sub BtnPen_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
' Debug.Print "in BtnPen_Click ----------------------"
If BtnPenExecuted Then
BtnPenExecuted = False
' Debug.Print "BtnPenExecuted,Exit Sub"
Exit Sub
End If
JustSelect = False
' Debug.Print Ctrl.TooltipText + "_Click: JustSelect = False"
JustPen = True
' Debug.Print Ctrl.TooltipText + "_Click: JustPen = True"
' Debug.Print "BtnPen.State="; BtnPen.State
If BtnPenPressed Then
BtnPenPressed = False
' Debug.Print "BtnPenPressed = False"
BtnPenClickTime = Timer
Exit Sub
End If
If Timer - BtnPenClickTime < 0.5 Then
BtnPenDblClick = True
' Debug.Print Ctrl.TooltipText + "_Click: BtnPenDblClick = True"
BtnPenPressed = True
' Debug.Print Ctrl.TooltipText + "_Click: BtnPenPressed = True"
Else
BtnPenDblClick = False
' Debug.Print Ctrl.TooltipText + "_Click: BtnPenDblClick = False"
End If
BtnPenClickTime = Timer
End Sub
Private Sub BtnSelect_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
JustSelect = True
' Debug.Print Ctrl.TooltipText + "_Click: JustSelect = True"
End Sub
#6
感谢zhao4zhong1的支持与帮助
你的代码是否采用VSTO?
我对VB不熟悉,能否给我大概讲一下VB工程的建立过程及工程代码。
发给我邮件也可以 chenwx110@hotmail.com
你的代码是否采用VSTO?
我对VB不熟悉,能否给我大概讲一下VB工程的建立过程及工程代码。
发给我邮件也可以 chenwx110@hotmail.com
#7
问题还没解决,谢谢大家支持,结贴啦。
#1
说明一下,结帖率0%我想是因为我第一次提问吧,大家不要被吓倒啦。
#2
没有了解过这块,帮顶
#3
在Word2003中开始记录宏,手动完成所需功能,结束记录宏,按Alt+F11键,查看刚才记录的宏对应的VBA代码。
#4
谢谢zhao4zhong1的回复,
之前是有做过宏记录的,内容如下:
Sub dl1()
'
' dl1 Macro
' 宏在 2013-6-25 由 User 录制
'
With ActiveDocument.Shapes.BuildFreeform(msoEditingCorner, 81.75, 102.75)
.AddNodes msoSegmentCurve, msoEditingCorner, 82.85, 97.2, 84.2, _
96.4, 87.75, 92.25
.AddNodes msoSegmentCurve, msoEditingCorner, 88.35, 91.55, 88.55, _
90.6, 89.25, 90#
.AddNodes msoSegmentCurve, msoEditingCorner, 90.35, 89.05, 91.85, _
88.6, 93#, 87.75
.AddNodes msoSegmentCurve, msoEditingCorner, 93.85, 87.1, 94.3, _
86#, 95.25, 85.5
.AddNodes msoSegmentCurve, msoEditingCorner, 97.6, 84.2, 100.35, _
83.7, 102.75, 82.5
.AddNodes msoSegmentCurve, msoEditingCorner, 105.05, 83.05, 106.25, _
83#, 108#, 84.75
.AddNodes msoSegmentCurve, msoEditingCorner, 108.65, 85.4, 108.85, _
86.35, 109.5, 87#
.AddNodes msoSegmentCurve, msoEditingCorner, 110.15, 87.65, 111.1, _
87.85, 111.75, 88.5
.AddNodes msoSegmentCurve, msoEditingCorner, 115.45, 92.2, 118.8, _
96.35, 120.75, 101.25
.AddNodes msoSegmentCurve, msoEditingCorner, 124.05, 109.45, 120.2, _
100.85, 124.5, 108#
.AddNodes msoSegmentCurve, msoEditingCorner, 124.65, 108.2, 124.5, _
108.5, 124.5, 108.75
.ConvertToShape.Select
End With
End Sub
目前是已经实现了程序画线的功能,现在是要在Word下捕获、响应鼠标后画线,能做到类似Word绘图的效果。
之前是有做过宏记录的,内容如下:
Sub dl1()
'
' dl1 Macro
' 宏在 2013-6-25 由 User 录制
'
With ActiveDocument.Shapes.BuildFreeform(msoEditingCorner, 81.75, 102.75)
.AddNodes msoSegmentCurve, msoEditingCorner, 82.85, 97.2, 84.2, _
96.4, 87.75, 92.25
.AddNodes msoSegmentCurve, msoEditingCorner, 88.35, 91.55, 88.55, _
90.6, 89.25, 90#
.AddNodes msoSegmentCurve, msoEditingCorner, 90.35, 89.05, 91.85, _
88.6, 93#, 87.75
.AddNodes msoSegmentCurve, msoEditingCorner, 93.85, 87.1, 94.3, _
86#, 95.25, 85.5
.AddNodes msoSegmentCurve, msoEditingCorner, 97.6, 84.2, 100.35, _
83.7, 102.75, 82.5
.AddNodes msoSegmentCurve, msoEditingCorner, 105.05, 83.05, 106.25, _
83#, 108#, 84.75
.AddNodes msoSegmentCurve, msoEditingCorner, 108.65, 85.4, 108.85, _
86.35, 109.5, 87#
.AddNodes msoSegmentCurve, msoEditingCorner, 110.15, 87.65, 111.1, _
87.85, 111.75, 88.5
.AddNodes msoSegmentCurve, msoEditingCorner, 115.45, 92.2, 118.8, _
96.35, 120.75, 101.25
.AddNodes msoSegmentCurve, msoEditingCorner, 124.05, 109.45, 120.2, _
100.85, 124.5, 108#
.AddNodes msoSegmentCurve, msoEditingCorner, 124.65, 108.2, 124.5, _
108.5, 124.5, 108.75
.ConvertToShape.Select
End With
End Sub
目前是已经实现了程序画线的功能,现在是要在Word下捕获、响应鼠标后画线,能做到类似Word绘图的效果。
#5
Sub File()'Word.EventClassModule-------------------------------------------------------------------
End Sub
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "EventClassModule"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public WithEvents App As Application
Attribute App.VB_VarHelpID = -1
Public WithEvents BtnPen As CommandBarButton
Attribute BtnPen.VB_VarHelpID = -1
Public JustPen As Boolean
Public WithEvents BtnSelect As CommandBarButton
Attribute BtnSelect.VB_VarHelpID = -1
Public JustSelect As Boolean
Public BtnPenClickTime As Single
Public BtnPenDblClick As Boolean
Public BtnPenPressed As Boolean
Public BtnPenExecuted As Boolean
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
' Debug.Print "App_WindowSelectionChange(Sel.Type=" + CStr(Sel.Type) + ",Sel.Text=" + Sel.Text + ")"
' Debug.Print "BtnPen.State="; BtnPen.State
' Debug.Print "JustPen=" + CStr(JustPen)
' Debug.Print "BtnSelect.State="; BtnSelect.State
' Debug.Print "JustSelect=" + CStr(JustSelect)
If BtnPenPressed Then
Sel.Start = Sel.Start: Sel.End = Sel.End '消除当前图形对象上的选择框
' Debug.Print "Execute Again"
BtnPenExecuted = True
App.CommandBars("笔相关").Controls("笔").Execute
Exit Sub
End If
If Sel.Type = wdSelectionShape Then
If Not (BtnSelect.State = msoButtonDown Or JustSelect) Then
Sel.Start = Sel.Start: Sel.End = Sel.End '消除当前图形对象上的选择框
End If
Else
JustSelect = False
End If
JustPen = False
End Sub
Private Sub BtnPen_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
' Debug.Print "in BtnPen_Click ----------------------"
If BtnPenExecuted Then
BtnPenExecuted = False
' Debug.Print "BtnPenExecuted,Exit Sub"
Exit Sub
End If
JustSelect = False
' Debug.Print Ctrl.TooltipText + "_Click: JustSelect = False"
JustPen = True
' Debug.Print Ctrl.TooltipText + "_Click: JustPen = True"
' Debug.Print "BtnPen.State="; BtnPen.State
If BtnPenPressed Then
BtnPenPressed = False
' Debug.Print "BtnPenPressed = False"
BtnPenClickTime = Timer
Exit Sub
End If
If Timer - BtnPenClickTime < 0.5 Then
BtnPenDblClick = True
' Debug.Print Ctrl.TooltipText + "_Click: BtnPenDblClick = True"
BtnPenPressed = True
' Debug.Print Ctrl.TooltipText + "_Click: BtnPenPressed = True"
Else
BtnPenDblClick = False
' Debug.Print Ctrl.TooltipText + "_Click: BtnPenDblClick = False"
End If
BtnPenClickTime = Timer
End Sub
Private Sub BtnSelect_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
JustSelect = True
' Debug.Print Ctrl.TooltipText + "_Click: JustSelect = True"
End Sub
#6
感谢zhao4zhong1的支持与帮助
你的代码是否采用VSTO?
我对VB不熟悉,能否给我大概讲一下VB工程的建立过程及工程代码。
发给我邮件也可以 chenwx110@hotmail.com
你的代码是否采用VSTO?
我对VB不熟悉,能否给我大概讲一下VB工程的建立过程及工程代码。
发给我邮件也可以 chenwx110@hotmail.com
#7
问题还没解决,谢谢大家支持,结贴啦。