VBScript操作Word文件

Dim txtFile
Dim wordFile

chick() chick()
  txtFile = document.getElementById( "txtFile").value
  wordFile = document.getElementById( "wordFile").value

   If Len( trim(txtFile)) = 0 Or Len( trim(wordFile)) = 0 Then
    MsgBox "请选择文件！"
   Else
    dowrite()
   End If
end function

dowrite() dowrite()
   Set fso = CreateObject( "Scripting.FileSystemObject")
   Dim strAry()
   Dim linCount
   Dim strLine
   ReDim strAry(1000)

   Set TxtFile = fso.OpenTextFile(txtFile,1, False)

   While Not TxtFile.AtEndOfStream
    strLine = TxtFile.ReadLine
     If Len(strLine) > 0 Then
      strAry(linCount) = strLine
      linCount = linCount + 1
     End If
   Wend

   Set myDocApp = CreateObject( "Word.Application")
  myDocApp.Visible = True
  myDocApp.Activate
  myDocApp.Application.ScreenUpdating = False
   set myDoc = myDocApp.Documents.Open(wordFile)

   Set objSelection = myDocApp.Selection
   For i = 0 To linCount-1
  objSelection.Font.Name = "黑体"
  objSelection.Font.Size = 22
  objSelection.ParagraphFormat.Alignment = 1
  objSelection.ParagraphFormat.LineSpacingRule = 0
  objSelection.Font.Bold = true

  objSelection.TypeText "检测报告单"&vbCrLf

  objSelection.Font.Size = 12
  objSelection.Font.Bold = false

   Set table1 = objSelection.Tables.Add(objSelection.Range, 14, 6)
   Set Table1 = myDoc.Tables(i+1)
   With Table1
  .PreferredWidthType = 2
  .PreferredWidth = 100
  .Columns.PreferredWidthType = 2
   With .Borders(-2)
  .LineStyle = 1
  .LineWidth = 4
  .Color = -16777216
   End With
   With .Borders(-4)
    .LineStyle = 1
  .LineWidth = 4
  .Color = -16777216
   End With
   With .Borders(-1)
    .LineStyle = 1
  .LineWidth = 4
  .Color = -16777216
   End With
   With .Borders(-3)
    .LineStyle = 1
  .LineWidth = 4
  .Color = -16777216
   End With
   With .Borders(-5)
    .LineStyle = 1
  .LineWidth = 4
  .Color = -16777216
   End With
  .Borders(-7).LineStyle = 0
  .Borders(-8).LineStyle = 0
  .Borders.Shadow = False
   End With
   With myDocApp.Options
  .DefaultBorderLineStyle = 1
  .DefaultBorderLineWidth = 4
  .DefaultBorderColor = -16777216
   End With    
   '合并单元格 开始

   '第一行合并单元格
  objSelection.MoveRight 1, 6, 1
  objSelection.Cells.Merge

   '第五行合并单元格
  objSelection.MoveRight 1,2
  objSelection.MoveDown 5,3
  objSelection.MoveRight 1, 6, 1
  objSelection.Cells.Merge

   '第六行的第一二列合并单元格
  objSelection.MoveRight 1,2
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge
   '第六行的第三四列合并单元格
  objSelection.MoveRight 1,1
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge

   '第六行的第五六列合并单元格
  objSelection.MoveRight 1,1
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge

   '第七行的第一二列合并单元格
  objSelection.MoveRight 1,2
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge
   '第七行的第三四列合并单元格
  objSelection.MoveRight 1,1
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge
   '第七、八、九行的第五六列合并单元格
  objSelection.MoveRight 1,1
  objSelection.MoveRight 1, 2, 1
  objSelection.MoveDown 5,2,1
  objSelection.Cells.Merge

   '第八行的第一二列合并单元格
  objSelection.MoveRight 1,2
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge
   '第八行的第三四列合并单元格
  objSelection.MoveRight 1,1
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge

   '第九行的第一二列合并单元格
  objSelection.MoveRight 1,3
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge
   '第九行的第三四列合并单元格
  objSelection.MoveRight 1,1
  objSelection.MoveRight 1, 2, 1
  objSelection.Cells.Merge

   '第十行合并单元格
  objSelection.MoveRight 1,3
  objSelection.MoveRight 1, 6, 1
  objSelection.Cells.Merge

   '第十一、十二、十三、十四行合并单元格
  objSelection.MoveRight 1,2
  objSelection.MoveRight 1, 6, 1
  objSelection.MoveDown 5,3,1
  objSelection.Cells.Merge

   '合并单元格 结束
   '填写内容 开始
  Table1.Cell(1,1).Range.Text = "基本信息"

  Table1.Cell(2,1).Range.Text = "样品编号"
  Table1.Cell(2,2).Range.Text = Mid(strAry(i),21,15)
  Table1.Cell(2,3).Range.Text = "姓名"
  Table1.Cell(2,4).Range.Text = ""
  Table1.Cell(2,5).Range.Text = "性别"
  Table1.Cell(2,6).Range.Text = ""

  Table1.Cell(3,1).Range.Text = "年        龄"
  Table1.Cell(3,2).Range.Text = ""
  Table1.Cell(3,3).Range.Text = "病历号"
  Table1.Cell(3,4).Range.Text = ""
  Table1.Cell(3,5).Range.Text = "床位号"
  Table1.Cell(3,6).Range.Text = ""

  Table1.Cell(4,1).Range.Text = "送检日期"
  Table1.Cell(4,2).Range.Text = Mid(strAry(i),6,15)
  Table1.Cell(4,3).Range.Text = "临床诊断"
  Table1.Cell(4,4).Range.Text = ""
  Table1.Cell(4,5).Range.Text = ""
  Table1.Cell(4,6).Range.Text = ""

  Table1.Cell(5,1).Range.Text = "检测结果"

  Table1.Cell(6,1).Range.Text = "指标"
  Table1.Cell(6,2).Range.Text = "检测值"
  Table1.Cell(6,3).Range.Text = "阴阳性"

  Table1.Cell(7,1).Range.Text = "0分钟(T0)"
  Table1.Cell(8,1).Range.Text = "20分钟(T1)"
  Table1.Cell(9,1).Range.Text = "差值"

  Table1.Cell(9,2).Range.Text = Right( Left(strAry(i),5),4)

  Table1.Cell(7,3).Range.Text = "阴性(＜4.0)"&vbCrLf& "阳性(≥4.0)"

  Table1.Cell(10,1).Range.Text = "结果评价"
  objSelection.ParagraphFormat.Alignment = 3
  Table1.Cell(11,1).Range.Text = ""&vbCrLf&"13C-UREA呼气试验Hp结果为:"

   '填写内容 结束

  objSelection.EndKey(6)
  objSelection.ParagraphFormat.Alignment = 3    
  objSelection.TypeText "检验人:                                                                                检验日期:"&vbCrLf
   If (i+1) Mod 2 = 1 Then
    objSelection.TypeText ""&vbCrLf&"-------------------剪------------- 切---------------线---------------"&vbCrLf    
   End If
   Next
  myDoc.close()
  myDocApp.quit()
end function

本文出自 “海阔天空” 博客，谢绝转载！