[求助]怎样用vba实现图形加粗?（已解决）

gao2ming1

在学习vba编程过程，发现有太多的不懂，请问如何用vba实现对选中任意图形（或组合）加粗，减细，最好是每运行一次变化一些，谢谢帮助！

[此贴子已经被作者于2007-5-11 10:45:49编辑过]

守柔

QUOTE:

以下是引用gao2ming1在2007-5-10 21:38:55的发言：

在学习vba编程过程，发现有太多的不懂，请问如何用vba实现对选中任意图形（或组合）加粗，减细，最好是每运行一次变化一些，谢谢帮助！

我未做认真测试，以下代码仅供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2007-5-11 5:55:19
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0204^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit

Sub LinesChangeWeight(TF As Boolean)
    Dim myShapes As ShapeRange
    Dim myWeight As Single, i As Single
    On Error Resume Next
    '如果选定状态非浮动式图形选定状态则退出运行
    If Selection.Type <> wdSelectionShape Then Exit Sub
    Set myShapes = Selection.ShapeRange
    If myShapes.Line.Weight < 0 Then
        myWeight = 0
    Else
        myWeight = myShapes.Line.Weight
    End If
    If TF = True Then
        myShapes.Line.Visible = msoTrue    '加宽时显示所有线条
        '可任意设置线宽起始值和终止值\步长
        For i = myWeight + 0.1 To 6 Step 0.1
            myShapes.Line.Weight = i
            Application.ScreenRefresh
            If MsgBox("已将当前图形的线宽应用为" & i & "磅,是否确定为适宜线宽?", vbYesNo) = vbYes Then Exit Sub
        Next
    Else
        If myWeight = 0 Then Exit Sub
        '可任意设置线宽起始值和终止值\步长
        For i = myWeight - 0.1 To 0 Step -0.1
            myShapes.Line.Weight = i
            Application.ScreenRefresh
            If MsgBox("已将当前图形的线宽应用为" & i & "磅,是否确定为适宜线宽?", vbYesNo) = vbYes Then Exit Sub
        Next
        If i = 0 Then myShapes.Line.Visible = msoFalse    '0磅时隐藏线条
    End If
End Sub
'----------------------
Sub Example()
'True为渐宽,Flase为渐细
    Call LinesChangeWeight(True)
End Sub
'----------------------

[此贴子已经被作者于2007-5-11 5:57:00编辑过]

gao2ming1

守柔版主：非常感谢，我在word2003中测试了以上代码，已成功。