VB.NET2008 使用WORD 艺术字详解

最近被要求在一个项目中写一个简单的编辑器，并且要融入WORD的艺术字功能，咋看通过COM方式应该比较容易搞定，于是打开BAIDU,GOOGLE搜寻了一遍，只能感叹如此多的条条目目都是一样的COPY版而已。发现网上版本最多的就是两种版本：

1.WORD 97和VB6.0的组合

2.使用API GDI功能模拟艺术字的效果

 

我是一个懒人，本着从简原则，第二种方案直接放弃，因此选用第一种方案，在优快云的下载找到的6.0代码如下

 

 

Dim Effect As Short '增加一个新的WORD文档 wdApp.Documents.Add.Select() '向文档中添加文本 wdApp.ActiveDocument.Shapes.AddTextEffect(0, "VB艺术字", "方正舒体", 72, 0, 0, 0, 0).Select() '随即获取艺术代号 Randomize() Effect = Int(Rnd(1) * 30) '设定艺术效果 wdApp.Selection.ShapeRange.TextEffect.PresetTextEffect = Effect '设置文本字体 wdApp.Selection.ShapeRange.TextEffect.FontName = "方正舒体" '将艺术文本区域复制到剪贴板 wdApp.Selection.Copy() '将剪贴板图形复制到窗体 Me.BackgroundImageLayout = System.Windows.Forms.ImageLayout.None Me.BackgroundImage = My.Computer.Clipboard.GetImage() '信息显示 Me.Text = "VB中调用WORD艺术字演示，当前艺术效果代号：" & CStr(Effect)

 

通过代码，原理还是比较简单的，通过COM方式构建一个WORD,插入艺术字后通过系统的剪粘板复制出来，然后SHOW出来。

不过当移植到VB.NET时，这段代码就不能执行成功了，起初以为是OFFICE版本问题，不过在不同版本OFFICE之间，VB6.0的EXE都可以顺利执行。可见问题的症结点不在这里，通过DEBUG猛然发现 Clipboard对象在执行COPY之后还是空的，无奈手动执行了一遍复制黏贴操作，没有问题，无奈又揣着这个问题去百度，GOOGLE了一把，终于终于在一篇“substitute way to extract Shapes as images from MS Word documents“文中找到了答案，原来是在WORD中的SHAPE是有类型的，而我们插入的艺术字没有定义这样一个类型，通过CLIPBOARD后，由于类型不明确，所以对象是空的，解决的办法就是将WORD 中的SHAPE进行类型转换，代码参考了该文的VSTO代码，实例代码如下

Dim wdApp As New Microsoft.Office.Interop.Word.Application Dim Effect As Short '增加一个新的WORD文档 wdApp.Documents.Add.Select() '向文档中添加文本 wdApp.ActiveDocument.Shapes.AddTextEffect(0, RichTextBox1.Text, RichTextBox1.Font.FontFamily.Name, RichTextBox1.Font.Size, 0, 0, 0, 0).Select() Effect = Int(fevalue) '设定艺术效果 wdApp.Selection.ShapeRange.TextEffect.PresetTextEffect = Effect '设置文本字体 wdApp.Selection.ShapeRange.TextEffect.FontName = RichTextBox1.Font.FontFamily.Name '将艺术文本区域复制到剪贴板 Dim shapes As Microsoft.Office.Interop.Word.InlineShape '定义InlineShape 变量 shapes Dim FontEffectName As String For Each inlineShape As Microsoft.Office.Interop.Word.Shape In wdApp.ActiveDocument.Shapes '遍历Word中所有的Shape 对象集 shapes = inlineShape.ConvertToInlineShape() '本次只用一个Word对象，故直接将得到得shape对象转换为InlineShape对象 shapes.Select() '由于Common Shape对象的Select方法有Bug,此法为变通方法 '选中转换后的shape对象 wdApp.Selection.CopyAsPicture() '将对象以图片形式复制到剪切板 FontEffectName = Format(Now, "HHmmss") If System.Windows.Forms.Clipboard.ContainsImage() Then System.Windows.Forms.Clipboard.GetImage().Save(My.Application.Info.DirectoryPath & "/Pic/" & FontEffectName & ".gif", System.Drawing.Imaging.ImageFormat.Gif) '保存到该应用程序下 Else Throw New Exception("error occures when copying picture") End If Next 'wdApp = Nothing '释放对象 Me.killWordProcess() '手动清除word进程 If FontEffectName <> Nothing Then ADEditor.WebBrowser1.Document.ExecCommand("InsertImage", False, My.Application.Info.DirectoryPath & "/Pic/" & FontEffectName & ".gif") '在WebBrowser1隐式插入该图片 End If Me.Close() Else MsgBox("请输入文字") End If

至此，VB.NET艺术字顺利搞定。