[求助]html编辑器图文打印 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

1、代码

Dim mb As String = FileSys.ReadAllText(ProjectPath & "初始模板.html")
Dim tbl As Table = Tables("通知单") '选中的多行
Dim str As String = ""
For i As Integer = tbl.TopRow To tbl.BottomRow
 Dim s = mb
 Dim r As Row = tbl.Rows(i)
 str &= s.Replace("（绑定编号）",r("编号")).Replace("（绑定html_内容）",r("html_内容")).Replace("../","./")
Next
str = "<body><html>" & str & "</body></html>"
FileSys.WriteAllText(ProjectPath & "新模板.doc", str, False)
Dim Proc As New Process '定义一个新的Process
Proc.File = ProjectPath & "新模板.doc" '指定要打开的文件
Proc.Start()

2、模板

【编号信息】


（绑定编号）


【题目内容】


（绑定html_内容）

比如

Dim app As New MSWord.Application
try
    Dim fileName = "d:\test.doc"
    Dim doc As Object = app.Documents.Open(fileName)

    app.ActiveWindow.ActivePane.View.Type = MSWord.WdViewType.wdPrintView

    app.Visible = True

catch ex As exception
msgbox(ex.message)
app.Quit
End try

插入图片的时候，直接嵌入图片，如

Tables(e.Form.TableName).current("html_内容") = EditorHelper.BodyHtml
'******复制新文件*********
Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter= "图片文件|*.bmp;*.jpg;*.gif;*.png;*.jpeg;*.tiff" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
 '********调用html编辑器***********
 Dim wbs1 As Object = e.Form.Controls("WebBrowser1").basecontrol
 wbs1.Url = new System.Uri(ProjectPath & "kindeditor\e.html", System.UriKind.Absolute)
 EditorHelper = new ObjectForScriptingHelper
 wbs1.ObjectForScripting = EditorHelper
 '修改html内容
 Dim wb As new WeUI
 Dim base64 = wb.ImageToBase64(getimage(dlg.FileName))
 With Tables(e.Form.TableName)
 .Current("html_内容") = .Current("html_内容") & "<img alt="""" src=""" & base64 & """ />"
 EditorHelper.RequestContent( .current("html_内容"))
 End With
End If
'
Dim wbs As Object = e.Form.Controls("WebBrowser1").basecontrol
wbs.Url = new System.Uri(ProjectPath & "kindeditor\e.html", System.UriKind.Absolute)
EditorHelper = new ObjectForScriptingHelper
wbs.ObjectForScripting = EditorHelper
''修改html内容
With Tables("通知单")
 EditorHelper.RequestContent( .current("html_内容"))
End With

1、不需要修改之前的插入图片方式；

2、修改保存代码，如

'''
Dim mb As String = FileSys.ReadAllText(ProjectPath & "初始模板.html")
Dim tbl As Table = Tables("通知单") '选中的多行
Dim str As String = ""
For i As Integer = tbl.TopRow To tbl.BottomRow
 Dim s = mb
 Dim r As Row = tbl.Rows(i)
 str &= s.Replace("（绑定编号）",r("编号")).Replace("（绑定html_内容）",r("html_内容")).Replace("../","./")
Next
str = "<body><html>" & str & "</body></html>"
FileSys.WriteAllText(ProjectPath & "新模板.doc", str, False)
Dim app As new msword.application
Dim Doc = app.Documents.open(ProjectPath & "新模板.doc")
Doc.saveas(FileName:=projectpath & "test123.doc", FileFormat:=0)
app.visible = True

1、你这种是正常情况，转换成word的时候，没有图片大小信息，没办法处理的。

2、具体问题，做一个实例发上来测试。

如下代码

'''
If DataTables("通知单").Select("标注 = true").count = 0 Then
    Dim Result As DialogResult
    Result = MessageBox.Show("你没有选中数据,请勾选复选框!"& vbcrlf &"是---返回"& vbcrlf &"否---关闭", "提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
    If Result = DialogResult.Yes Then
        Return
    Else
        Return
    End If
End If

If DataTables("通知单").Select("标注 = true").count > 0 Then
 For Each r As Row In Tables("通知单") '显示标注
 Tables("通知单").Filter = "标注 = True"
 Next

 Dim mb As String = FileSys.ReadAllText(ProjectPath & "初始模板.html")
 Dim tbl As Table = Tables("通知单") '选中的多行
 Dim str As String = ""
 'For i As Integer = tbl.TopRow To tbl.BottomRow
 For Each r As DataRow In DataTables("通知单").Select("标注 = true")
 Dim s = mb
 'Dim r As Row = tbl.Rows(i)
 str &= s.Replace("（绑定编号）",r("编号")).Replace("（绑定html_内容）",r("html_内容")).Replace("../","./").Replace("（绑定html_要求）",r("html_要求")).Replace("../","./")
 Next

 Dim txt As String = str
 Dim pattern As String = "<img .+?/>"

 Dim rgx = new System.Text.RegularExpressions.Regex(pattern, System.Text.RegularExpressions.RegexOptions.IgnoreCase)
 For Each match As System.Text.RegularExpressions.Match In rgx.Matches(txt)
 Dim s As String = match.Value
 Dim w As Integer = -1
 Dim h As Integer = -1
 Dim mc = System.Text.RegularExpressions.Regex.Matches(s, "(?<=width:)[0-9]+(?=px)")
 If mc.count > 0 Then
 w = mc(0).value
 End If
 mc = System.Text.RegularExpressions.Regex.Matches(s, "(?<=height:)[0-9]+(?=px)")
 If mc.count > 0 Then
 h = mc(0).value
 End If
 If w <> -1 Then
 s = System.Text.RegularExpressions.Regex.replace(s, "width=\"".*?\""", "width=""" & w & """")
 s = System.Text.RegularExpressions.Regex.replace(s, "height=\"".*?\""", "height=""" & h & """")
 'msgbox(s)
 str = str.replace(match.Value, s)
 End If
 Next


 str = "<body><html>" & str & "</body></html>"
 FileSys.WriteAllText(ProjectPath & "新模板.doc", str, False)
End If

Dim app As New MSWord.Application
Dim Doc = app.Documents.open(ProjectPath & "新模板.doc")
Doc.saveas(FileName:=projectpath & "Attachments/" & "新.doc", FileFormat:=0)
app.ActiveWindow.ActivePane.View.Type = MSWord.WdViewType.wdPrintView
app.visible = True

主题：[求助]html编辑器图文打印