编程实现Word里画线

时间:2021-09-28 06:24:20
    近期要做一个Word里用鼠标画线的功能。
    查阅资料后,我自己可以实现Word里用VC代码画线的功能,但实际的需求是需要用户按鼠标左键、移动鼠标画线。
    找不到思路啦...求助坛子里的各位,谢谢!

7 个解决方案

#1


说明一下,结帖率0%我想是因为我第一次提问吧,大家不要被吓倒啦。  编程实现Word里画线

#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绘图的效果。

#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

#7


问题还没解决,谢谢大家支持,结贴啦。

#1


说明一下,结帖率0%我想是因为我第一次提问吧,大家不要被吓倒啦。  编程实现Word里画线

#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绘图的效果。

#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

#7


问题还没解决,谢谢大家支持,结贴啦。