VB控制Word文档实例精选一

时间：2024-03-27 11:48:47

 

转自：http://blog.csdn.net/chenjl1031/article/details/8905354

1、在Word文档中插入表格，给单元格赋值，访问单元格内容，拆分及合并单元格

[vb] view plaincopy
  1. '先引用Microsoft Word 11.0 Object Library  
  2. Option Explicit  
  3.   
  4. Dim WordApp As Word.Application '创建Word应用程序  
  5.   
  6. Private Sub Command1_Click()  
  7.       
  8.     Set WordApp = New Word.Application '实例化  
  9.     WordApp.Visible = True '显示 Office Word 界面  
  10.     '或者Application.Visible = True  
  11.     WordApp.DisplayAlerts = False '不提示保存对话框  
  12.     WordApp.Documents.Add '创建新的空白Word文档  
  13.     WordApp.Selection.EndKey unit:=wdStory  '将光标移到文档末尾，在文本后面插入表格  
  14.     Selection.TypeText Text:="我的Word表格" '表格的标题名称  
  15.     Call WordApp.ActiveDocument.Tables.Add(WordApp.Application.Selection.Range, 10, 5, 1, 0) '插入一个10行5列的表格  
  16.     Selection.Tables(1).Columns.Width = 80 '定义表格的列宽  
  17.       
  18.     '给单元格赋值  
  19.     WordApp.ActiveDocument.Tables(1).Cell(1, 1).Range.InsertAfter "序号"  
  20.     WordApp.ActiveDocument.Tables(1).Cell(1, 2).Range.InsertAfter "项目1"  
  21.     WordApp.ActiveDocument.Tables(1).Cell(1, 3).Range.InsertAfter "项目2"  
  22.     WordApp.ActiveDocument.Tables(1).Cell(1, 4).Range.InsertAfter "项目3"  
  23.     WordApp.ActiveDocument.Tables(1).Cell(1, 5).Range.InsertAfter "项目4"  
  24.       
  25.     '合并单元格  
  26.     WordApp.ActiveDocument.Tables(1).Cell(2, 2).Select '选中表格的第2行第2列  
  27.     Call WordApp.Application.Selection.MoveDown(5, 3, 1) '向下移动3格  
  28.     WordApp.Application.Selection.Cells.Merge '合并4个格子  
  29.       
  30.     '拆分单元格  
  31.     WordApp.ActiveDocument.Tables(1).Cell(10, 2).Select '选中表格的第10行第2列  
  32.     Call WordApp.Application.Selection.Cells.Split(7, 2, True) '拆分成7行2列      
  33.       
  34.     '访问单元格内容  
  35.     Debug.Print WordApp.ActiveDocument.Tables(1).Cell(1, 1).Range.Text '第1行第1列的内容  
  36.       
  37.     ActiveDocument.SaveAs "c:\MyWord.doc" '保存最后生成的word文档  
  38.   
  39. End Sub  
  40.   
  41. Private Sub Form_Unload(Cancel As Integer)  
  42.     On Error Resume Next  
  43.     WordApp.Quit  
  44.     Set WordApp = Nothing  
  45. End Sub  

        生成的表格如下图所示：

VB控制Word文档实例精选一


        2、在Word文档中插入和导出图片对象

[vb] view plaincopy
  1. '先引用Microsoft Word 11.0 Object Library  
  2. Option Explicit  
  3.   
  4. Dim WordApp As Word.Application '创建Word应用程序  
  5.   
  6. Private Sub Command1_Click()  
  7.     On Error GoTo Errhandler  
  8.     CommonDialog1.Filter = "Word(*.Doc)|*.Doc|AllFile(*.*)|*.*"  
  9.     CommonDialog1.FilterIndex = 1  
  10.     CommonDialog1.ShowOpen  
  11.     Set WordApp = New Word.Application '实例化  
  12.     WordApp.Documents.Open CommonDialog1.FileName '打开Word文件  
  13.     WordApp.Visible = True '显示 Office Word 界面  
  14.     '或者Application.Visible = True  
  15.     WordApp.DisplayAlerts = False '不提示保存对话框  
  16.     WordApp.Selection.EndKey Unit:=wdStory  '将光标移到文档末尾，在文本后面插入图片对象  
  17.     Selection.TypeText Text:="我的图片" '图片的标题名称  
  18.       
  19.     '插入图片对象  
  20.     Selection.InlineShapes.AddPicture FileName:="C:\CommandPicture.jpg", LinkToFile:=False, SaveWithDocument:=True  
  21.     Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend  
  22.     Selection.InlineShapes(1).ConvertToShape.Select  
  23.     Selection.ShapeRange.Fill.Visible = msoFalse  
  24.     Selection.ShapeRange.Fill.Transparency = 0#  
  25.     Selection.ShapeRange.Line.Weight = 0.75  
  26.     Selection.ShapeRange.Line.DashStyle = msoLineSolid  
  27.     Selection.ShapeRange.Line.Style = msoLineSingle  
  28.     Selection.ShapeRange.Line.Transparency = 0#  
  29.     Selection.ShapeRange.Line.Visible = msoFalse  
  30.     Selection.ShapeRange.LockAspectRatio = msoTrue  
  31.     Selection.ShapeRange.Height = 361.4  
  32.     Selection.ShapeRange.Width = 481.6  
  33.     Selection.ShapeRange.PictureFormat.Brightness = 0.5  
  34.     Selection.ShapeRange.PictureFormat.Contrast = 0.5  
  35.     Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic  
  36.     Selection.ShapeRange.PictureFormat.CropLeft = 0#  
  37.     Selection.ShapeRange.PictureFormat.CropRight = 0#  
  38.     Selection.ShapeRange.PictureFormat.CropTop = 0#  
  39.     Selection.ShapeRange.PictureFormat.CropBottom = 0#  
  40.     Selection.ShapeRange.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn  
  41.     Selection.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionPage  
  42.     Selection.ShapeRange.Left = wdShapeCenter  
  43.     Selection.ShapeRange.Top = wdShapeCenter  
  44.     Selection.ShapeRange.LockAnchor = False  
  45.     Selection.ShapeRange.WrapFormat.AllowOverlap = True  
  46.     Selection.ShapeRange.WrapFormat.Side = wdWrapBoth  
  47.     Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)  
  48.     Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)  
  49.     Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)  
  50.     Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)  
  51.     Selection.ShapeRange.WrapFormat.Type = 3  
  52.     Selection.ShapeRange.ZOrder msoSendBehindText  '设置图片为衬托于文字下方  
  53.   
  54.     '判断文档中是否存在图片对象  
  55.     If ActiveDocument.Shapes.Count + ActiveDocument.InlineShapes.Count > 0 Then  
  56.        '取得图片的2种方法  
  57.          
  58.        '第1种方法：用下面命令将文件另存为网页格式的文件，文件夹“MyWord.files”将保存Word文档中所有的图片  
  59.        '这种方法对所有的Word版本均适用  
  60.        ActiveDocument.SaveAs "c:\MyWord.htm", wdFormatHTML '保存为网页格式  
  61.          
  62.        '第2种方法：引用ADO对象库，将所有的图片保存在数据库中，然后可以一张一张地显示出来  
  63.          
  64.        '另外：  
  65.        '如果Word文档是docx格式的，那可以按这个办法解决：  
  66.        '.docx 格式的文件本质上是一个ZIP压缩文件，.docx 格式文件的主要内容是保存为XML格式的，但文件并非直接保存于磁盘。  
  67.        '它是保存在一个ZIP文件中，然后取扩展名为.docx。我们只需要用解压软件比如：WinZIP、WinRAR或者7ZIP等软件进行解压就可以了。  
  68.        '方法有两种，一种是将.docx后缀名修改为.zip后缀名；另一个方法就是打开WinZIP然后，选择此文档即可。  
  69.        '图片资源文件都被保存在word\media文件夹中。             
  70.          
  71.     Else  
  72.        Debug.Print "Word文档中不存在图片对象！"  
  73.     End If  
  74.   
  75. Errhandler:  
  76.     Exit Sub  
  77. End Sub  
  78.   
  79. Private Sub Form_Unload(Cancel As Integer)  
  80.     On Error Resume Next  
  81.     WordApp.Quit  
  82.     Set WordApp = Nothing  
  83. End Sub  


        3、统计Word文档页数、字数

[vb] view plaincopy
  1. '先引用Microsoft Word 11.0 Object Library  
  2. Option Explicit  
  3.   
  4. Dim WordApp As Word.Application '创建Word应用程序  
  5.   
  6. Private Sub Command1_Click()  
  7.     On Error GoTo Errhandler  
  8.     CommonDialog1.Filter = "Word(*.Doc)|*.Doc|AllFile(*.*)|*.*"  
  9.     CommonDialog1.FilterIndex = 1  
  10.     CommonDialog1.ShowOpen  
  11.     Set WordApp = New Word.Application '实例化  
  12.     WordApp.Documents.Open CommonDialog1.FileName '打开Word文件  
  13.     WordApp.Visible = False '不显示 Office Word 界面  
  14.     '或者Application.Visible = True  
  15.     'WordApp.DisplayAlerts = False '不提示保存对话框  
  16.       
  17.     Debug.Print WordApp.ActiveDocument.ComputeStatistics(Word.WdStatistic.wdStatisticPages) '页数  
  18.     Debug.Print WordApp.ActiveDocument.Characters.Count '字数  
  19.       
  20. Errhandler:  
  21.     Exit Sub  
  22. End Sub  
  23.   
  24. Private Sub Form_Unload(Cancel As Integer)  
  25.     On Error Resume Next  
  26.     WordApp.Quit  
  27.     Set WordApp = Nothing  
  28. End Sub  

相关文章