'''
Dim k As Integer
Dim nb As Integer = Tables("车辆信息").Rows.Count
For k=1 To nb
If Tables("车辆信息").Rows(nb-1)("内部样车编号") ="" Then
messagebox.show("请完善所有样车的内部养养编号","提示")
Return
End If
Next
Dim ps As System.Diagnostics.Process() = System.Diagnostics.Process.GetProcessesByName("WORD")
Dim st As Integer =e.Form.Controls("ComboBox1").text
Dim sp As Integer =e.Form.Controls("ComboBox2").text
Dim path As String = Rand.Next(1000,9999)
Dim rpath As String = Tables("参数").Rows(5)("参数值")
Dim file As image
If sp< st Then
messagebox.show("请选择正确的报告生成范围!","提示")
Return
End If
If Tables("原始记录").Rows(0)("原始记录路径")="" Then
messagebox.show("请确认原始记录路径无误!","提示")
Return
End If
Dim lj As String
Dim tm As String
Dim dr As DataRow
Dim wt2 As String
Dim tx As String
Dim txn As Integer
Dim ht2 As String
Dim ht3 As String
Dim ht4 As String
Dim i As Integer
Dim n2 As Integer
Dim Sheet As XLS.Sheet
Dim Style As XLS.Style
Dim Style2 As XLS.Style
Dim Style3 As XLS.Style
Dim a As Integer=st
Dim b As Integer=sp
StatusBar.ProgressBar.Visible =True
StatusBar.ProgressBar.Minimum =a
StatusBar.ProgressBar.Maximum = b
'Dim App As New MSExcel.Application
'App.Visible = True
tm = Tables("原始记录").Rows(0)("原始记录路径")
Dim fl As String = Tables("原始记录").Rows（0)("原始记录路径")
FileSys.CreateDirectory(rpath & Date.Today() &"-"& path)
For i = a To b
StatusBar.ProgressBar.Value = i
Dim MyFilename As String =rpath & Date.Today() &"-"& path &"\"& Tables("车辆信息").Rows(i-1)("内部样车编号") & ".doc"
Dim MyFilename2 As String =rpath & Date.Today() &"-"& path &"\"& Tables("车辆信息").Rows(i-1)("内部样车编号") & ".pdf"
'If vars("停止") Then Exit For
' p.Value = i
'====================================================================原始记录============================================================================
'=======================================================================================================================================================
Dim app As New MSWord.Application
try
Dim doc = app.Documents.Open(FileName:= fl, readonly:=True)
app.Visible = False
app.Selection.Find.Text = "[vin]"
app.Selection.Find.Replacement.ClearFormatting()
app.Selection.Find.Replacement.Text = Tables("车辆信息").Rows(i-1)("VIN")
app.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
app.Selection.Find.Text = "[发动机编号]"
app.Selection.Find.Replacement.ClearFormatting()
app.Selection.Find.Replacement.Text = Tables("车辆信息").Rows(i-1)("发动机编号")
app.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
app.Selection.Find.Text = "[车身颜色]"
app.Selection.Find.Replacement.ClearFormatting()
app.Selection.Find.Replacement.Text = Tables("车辆信息").Rows(i-1)("车辆颜色")
app.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
app.Selection.Find.Text = "[制造年月]"
app.Selection.Find.Replacement.ClearFormatting()
app.Selection.Find.Replacement.Text = Format(Tables("车辆信息").Rows(i-1)("生产日期"),"yyyy.MM.dd")
app.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
app.Selection.Find.Text = "[设备日期]"
app.Selection.Find.Replacement.ClearFormatting()
app.Selection.Find.Replacement.Text = Format(Tables("车辆信息").Rows(i-1)("抽样日期"),"yyyy.MM.dd")
app.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
app.Selection.Find.Text = "[抽样日期]"
app.Selection.Find.Replacement.ClearFormatting()
app.Selection.Find.Replacement.Text = Format(Tables("车辆信息").Rows(i-1)("抽样日期"),"yyyy.MM.dd")
app.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)
app.ActiveWindow.Selection.GoTo(1,,,4)
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader
If app.ActiveWindow.Selection.Find.Execute("[样品编号]") Then
app.Selection.Text = Tables("车辆信息").Rows(i-1)("内部样车编号")
End If
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekMainDocument
If app.ActiveWindow.Selection.Find.Execute("[样品编号]") Then
app.Selection.Text = Tables("车辆信息").Rows(i-1)("内部样车编号")
End If
If e.Form.Controls("r1").checked=True Then
Doc.saveas(FileName:= MyFilename, FileFormat:=0)
Else If e.Form.Controls("r2").checked=True Then
app.Documents(fl).ExportAsFixedFormat(MyFilename2, MSWord.WdExportFormat.wdExportFormatPDF)
End If
Catch ex As Exception
msgbox(ex.message)
finally
app.quit
End Try
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each p As System.Diagnostics.Process In ps
If p.MainWindowTitle.Contains("WORD") Then
p.kill
End If
Next
MessageBox.Show("原始记录生成成功!", "提示")
e.Form.close
Dim Proc As New Process
Proc.File = rpath & Date.Today() &"-"& path
Proc.Start
加好友 
发短信
Post By：2019/7/18 15:44:00 [只看该作者]
此主题相关图片如下：无标题.png