Office集成之“艺术字”

Posted 2021-05-16 goodlifesantook

 在Office的应用程序中我们可以使用艺术字来创建出丰富多彩的文字效果，那么如何在我们自己的程序中使用这种效果呢？

其实通过Office COM交互组件可以轻松完成这项任务，还记得前面我们的那个关于图像处理的例子吗？同样的道理，通过Clipboard的交互，我们可以很轻松地实现。

显示效果图：

源代码如下：

'标题：Office紧密集成之 艺术字
'编制：SANTOOK(QQ 120742353)
'关键字：Office,集成,Excel,艺术字,VB

Private Declare Sub InitCommonControls Lib "comctl32" ()

Private excelapp As New Excel.Application
Private excelbook As New Excel.Workbook
Private excelsheet As New Excel.Worksheet

Private Sub Command1_Click()
    If Me.Text1.Text <> "" Then
            Dim sp As Excel.Shape
        Set sp = excelsheet.Shapes.AddTextEffect(Val(Me.Combo1.Text), Me.Text1.Text, Me.Combo2.Text, Val(Me.Combo3.Text), Me.Check1.Value, Me.Check2.Value, 0, 0)
        sp.Copy
        Me.Image1.Picture = Clipboard.GetData
        sp.Delete
        Set sp = Nothing
    End If
End Sub

Private Sub form_Initialize()
InitCommonControls

End Sub

Private Sub Form_Load()
    Set excelbook = excelapp.Workbooks.Open(CombinePath(App.Path, "temp.xls"))
    Set excelsheet = excelbook.Sheets.Item(1)
    For i = 1 To 29
        Me.Combo1.AddItem i
    Next i
    Me.Combo1.Text = 1
    For i = 0 To Screen.FontCount - 1
        Me.Combo2.AddItem Screen.Fonts(i)
    Next i
    Me.Combo2.Text = "宋体"
    For i = 10 To 150
        Me.Combo3.AddItem i
    Next i
    Me.Combo3.Text = 30
End Sub

Private Sub Form_Unload(Cancel As Integer)
    excelbook.Close False
    Set excelbook = Nothing
    excelapp.Quit
    Set excelapp = Nothing
End Sub

 

Private Function CombinePath(ByVal path_name As String, ByVal file_name As String) As String    '路径组合方法
    CombinePath = IIf(Right(path_name, 1) = "/", path_name & file_name, path_name & "/" & file_name)
End Function

 

 

详细的源代码和文件请见我的空间