- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- 请问New MSWord.Application 能存为pdf吗 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=137931)
-- 发布时间：2019/7/18 15:44:00
-- 请问New MSWord.Application 能存为pdf吗
RT 感谢！
-- 发布时间：2019/7/18 15:51:00
--
参考：http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=49847
-- 发布时间：2019/7/19 15:06:00
--
请问一下用这个方法原来的模板文件会跳出以下对话框
有什么办法解决吗
此主题相关图片如下：无标题.png
-- 发布时间：2019/7/19 15:15:00
--
贴出完整代码看看
-- 发布时间：2019/7/19 15:18:00
--
\'\'\'
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
-- 发布时间：2019/7/19 15:37:00
--
没有办法。先保存再输出为pdf
-- 发布时间：2019/7/19 15:46:00
--
能选择不保存原word文档吗
-- 发布时间：2019/7/19 15:51:00
--
不保存就会弹出提示
-- 发布时间：2019/7/19 15:57:00
--
保存的话代码怎么操作？模板文件也修改了？
-- 发布时间：2019/7/19 16:40:00
--
这样试试
Dim app As New MSWord.Application
try
Dim fileName = "E:\\问题\\123.docx"
Dim doc = app.Documents.Open(fileName)
Doc.ActiveWindow.Selection.TypeText("Hello666666666666!")
Doc.saved = True
doc.ExportAsFixedFormat("E:\\问题\\test.pdf", MSWord.WdExportFormat.wdExportFormatPDF)
Doc.close
catch ex As exception
msgbox(ex.message)
finally
app.Quit
End try