wrdtest.frm

生成图文并茂的word文档

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   255
      Left            =   1560
      TabIndex        =   1
      Top             =   1440
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   255
      Left            =   480
      TabIndex        =   0
      Top             =   1440
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim wddoc As Word.Document
Dim wdpg As Word.PageSetup
Dim wd As New Word.Application
Dim wshp As Word.Shape
Dim px As Word.Paragraph
Dim tabx As Word.Table

Private Sub Command1_Click()
On Error GoTo errdlg
wd.Documents.Add
Set wddoc = wd.ActiveDocument
Set wdpg = wddoc.PageSetup
wdpg.PaperSize = wdPaperA4 '7 A3=6


wdpg.TopMargin = 150 * 8 / 28.2 '1.34
wdpg.BottomMargin = 111 * 8 / 28.2
wdpg.LeftMargin = 200 * 8 / 28.2 '1.79 25=2.24
wdpg.RightMargin = 90 * 8 / 28.2
'wdpg.PageWidth = InchesToPoints(14.87)  ' 1070.65
'wdpg.PageHeight = InchesToPoints(11)    ' 792
'wshp.Left
With wddoc.Sections(1).Footers(wdHeaderFooterPrimary)  '1
    .PageNumbers.Add wdAlignPageNumberRight            '2,1-center
End With

With wddoc.Sections(1).Headers(wdHeaderFooterPrimary)
    .Range.InsertBefore "分析报告"
    .Range.ParagraphFormat.Alignment = wdAlignParagraphRight '2,1-center

    '.Range.Footnotes.Add
    '.Range.InsertBreak
End With

'wddoc.Paragraphs.Add
'wddoc.Paragraphs.Item (1).Range.
'Set wshp = wddoc.Shapes.AddPicture("c:\zwx1502.bmp", False, True, 41, 60) ', 493, 250)
'wddoc.Range(1).Font.Name = "宋体"
'wddoc.Range(1).Font.Size = 9
'wddoc.Range(1).Text = "测试文档" + Chr(13) + Chr(13) + Chr(13)
Set px = wddoc.Paragraphs.Add
wddoc.Paragraphs.Item(1).Range.Bold = True
wddoc.Paragraphs.Item(1).Range.Text = "数据分析报告"
wddoc.Paragraphs.Item(1).Alignment = wdAlignParagraphCenter

Set px = wddoc.Paragraphs.Add
wddoc.Paragraphs.Item(2).Alignment = wdAlignParagraphCenter  '1
Call wddoc.Paragraphs.Item(2).Range.InlineShapes.AddPicture(App.Path & "\IBM T42.jpg", False, True)

Set px = wddoc.Paragraphs.Add
wddoc.Paragraphs.Item(3).Alignment = wdAlignParagraphLeft    '0
wddoc.Paragraphs.Item(3).Range.Font.Size = 9
'wddoc.Paragraphs.Item(3).Range.Text = ""
Set px = wddoc.Paragraphs.Add
wddoc.Paragraphs.Item(4).Range.Text = "1自然段把剪贴板上的图片贴到word的指定段落。把剪贴板上的图片贴到word的指定段落。把剪贴板上的图片贴到word的指定段落。把剪贴板上的图片贴到word的指定段落。把剪贴板上的图片贴到word的指定段落。"
Set px = wddoc.Paragraphs.Add
wddoc.Paragraphs.Item(5).Range.Font.Color = wdColorRed
wddoc.Paragraphs.Item(5).Range.Text = "2自然段把剪贴板上的图片贴到word的指定段落。把剪贴板上的图片贴到word的指定段落。把剪贴板上的图片贴到word的指定段落。把剪贴板上的图片贴到word的指定段落。把剪贴板上的图片贴到word的指定段落。"
Set px = wddoc.Paragraphs.Add
wddoc.Paragraphs.Item(6).Range.Font.Color = wdColorBlack
wddoc.Paragraphs.Item(6).Range.Text = ""

Set tabx = wddoc.Paragraphs.Item(6).Range.Tables.Add(wddoc.Paragraphs.Item(6).Range, 5, 6) '5行6列
tabx.Borders.InsideColor = wdColorLightOrange
tabx.Borders.OutsideColor = wdColorSkyBlue
tabx.Rows.Alignment = wdAlignRowCenter
tabx.Rows(1).Range.Bold = True
tabx.Rows(1).Height = 20
tabx.Rows(2).Height = 12

tabx.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
tabx.Rows(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
tabx.Cell(1, 1).Range.Text = "年份"
tabx.Cell(1, 2).Range.Text = "月份"
tabx.Columns(1).Width = 42
tabx.Columns(2).Width = 32

tabx.Cell(5, 6).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
tabx.Cell(5, 6).Range.Text = "9,931.27"
tabx.Cell(5, 1).Range.Text = "31.21"
Call wddoc.Activate
wd.Visible = True
Exit Sub
errdlg:
  MsgBox Err.Description + " " + Err.Source
exitf:
  wddoc.Close 0
  wd.Quit 0
  End
End Sub

Private Sub Command2_Click()
'wddoc.Close 0
'wd.Quit 0
'Set wd = Null
End Sub