之前写了个打印模板，来不及整理，先把代码放上。语言vb.net
Imports DC_Utility = DreamCube.Foundation.Basic.Utility
Imports Microsoft.Office.Interop.Word
Partial Class Projects_JILIN_MyForms_CHSCRWD_WordPrintTemplate
Inherits System.Web.UI.Page
'使用方法：
' 发到模板的数据字符串 = 模板Url#书签名=书签值=[类型]
'书签值：
对于CXTable：&标题字段1-标题字段2-标题字段3*CXTable数据内容，对于单选和复选：&书签名= GetCheckboxListInfo(&ID&) =chk/(或rdo)=数字(分几行显示);&;
'类型(可选)：
普通字段不需要填写，Checkboxlist类型为”chk&,Radioboxlist类型为“rdo&,日期字段为&time&
Protected Sub Page_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim sPostData As String = DC_Utility.MyWeb.GetPostString()
If Not String.IsNullOrEmpty(sPostData) Then
Dim sResult = GenerateWord(sPostData)
Response.Write(sResult)
Catch ex As Exception
MyLog.MakeLog(ex)
Response.Write(&Error&)
Response.End()
Private Function GenerateWord(ByVal sData As String) As String
Dim oDoc As Document = Nothing
Dim oApp As Application = Nothing
If String.IsNullOrEmpty(sData) Then
Dim aParams As String() = sData.Split(&#&)
Dim srcPath = aParams(0)
Dim sPostData As String = aParams(1)
If String.IsNullOrEmpty(sPostData) Then
If sPostData.EndsWith(&;&) Then
sPostData = sPostData.Substring(0, sPostData.Length - 1)
Dim sFileNameWithSuffix As String = MyString.strRight(srcPath, &/&, True)
Dim sUri As String = New Uri(srcPath).LocalPath
srcPath = Server.MapPath(sUri)
Dim sFileType As String = &.& + MyString.strRight(srcPath, &.&, True)
'Dim sDestPath As String = bine(Server.MapPath(&~&), &cache&) + &\& + sFileNameWithSuffix
sFileNameWithSuffix = DC_Utility.MyGuid.To_N(Guid.NewGuid()) + sFileType
Dim sDestPath As String = bine(Server.MapPath(&~&), &cache&) + &\& + sFileNameWithSuffix
File.Copy(srcPath, sDestPath, True)
Dim oMissing As Object = System.Reflection.Missing.Value
oApp = New ApplicationClass()
'Dim oDoc As Microsoft.Office.Interop.Word.Document = oApp.Documents.Add(sDestPath, oMissing, oMissing, oMissing)
oDoc = oApp.Documents.Open(sDestPath, oMissing, False, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing)
oDoc.Activate()
'项目名称=第三季度项目=1 ; 执行标准=工程测量规范|checked,高程测量规范|=chk
Dim aBookmarks As String() = sPostData.Split(&;&)
For i As Integer = 0 To aBookmarks.Length - 1
Dim sBookmarks As String = aBookmarks(i)
InsertBookmarValueToTableEx(oDoc, sBookmarks)
oDoc.Save()
Dim sUrl As String = MyWebsite.WebFolderUrl() + &/cache/& + sFileNameWithSuffix
Return sUrl
Catch ex As Exception
MyLog.MakeLog(ex)
Return ex.Message
If oDoc IsNot Nothing Then
oDoc.Close()
If oApp IsNot Nothing Then
oApp.Quit()
End Function
Private Sub InsertBookmarValueToTableEx(ByRef oDoc As Document, ByRef sBookmarks As String)
Dim aBookmarkItem As String() = sBookmarks.Split(&=&)
Dim sBookmarkName As String = aBookmarkItem(0)
Dim sBookmarkValue As String = aBookmarkItem(1)
Dim sFieldType As String = &&
If aBookmarkItem.Length & 2 Then
sFieldType = aBookmarkItem(2)
Dim oRange As Range = oDoc.Bookmarks.Item(sBookmarkName).Range
If String.IsNullOrEmpty(sFieldType) Then '普通单个字段
oRange.Text = sBookmarkValue
ElseIf sFieldType = &cxtb& Then
InsertCxTableDataToTable(oDoc, aBookmarkItem, sBookmarkValue, oRange)
ElseIf sFieldType = &chk& Or sFieldType = &rdo& Then
If aBookmarkItem.Length &= 3 Then
InsertCheckboxOrRadioButtonDataToWord(oDoc, aBookmarkItem, sBookmarkValue, oRange, sFieldType)
ElseIf sFieldType = &time& Then
Dim sTime As String = sBookmarkValue
sTime = sTime.Replace(&/&, &-&)
Dim sDate As String = sTime.Split(& &)(0)
Dim aItems As String() = sDate.Split(&-&)
sDate = aItems(0) + &年& + aItems(1) + &月& + aItems(2) + &日&
oRange.Text = sDate
Catch ex As Exception
Private Sub InsertCheckboxOrRadioButtonDataToWord(ByRef oDoc As Document, ByRef aBookmarkItem As String(), ByRef sBookmarkValue As String, ByRef oRange As Range, ByRef sFieldType As String, Optional ByVal bInsertContentControl As Boolean = True)
If String.IsNullOrEmpty(sBookmarkValue) Then
Dim aItems As String() = sBookmarkValue.Split(&,&)
Dim iColCount As Integer = Integer.Parse(aBookmarkItem(3))
If iColCount &= 0 Then
Dim iRowCount As Integer = Math.Ceiling(aItems.Length / iColCount)
Dim oTable As Table = oDoc.Tables.Add(oRange, iRowCount, iColCount)
Dim index As Integer = 0
For i As Integer = 1 To oTable.Rows.Count
For j As Integer = 1 To oTable.Columns.Count
Dim cell As Cell = oTable.Cell(i, j)
If index & aItems.Length - 1 Then
Dim sItem As String = aItems(index)
index += 1
Dim aCaptionAndState As String() = sItem.Split(&|&)
cell.Select()
If sFieldType = &chk& Then
InsertOneCheckbox(oDoc, aCaptionAndState, cell, bInsertContentControl)
InsertOneRadioButton(oDoc, aCaptionAndState, cell)
Catch ex As Exception
''' &summary&
''' 后两个可选参数是针对CXtable中使用的情况，不需复选框文字的时候，不解析aCaptionAndState直接传入选择状态（可选参数第一个为false的时候，第二个不可省略）
''' &/summary&
''' &param name=&oDoc&&&/param&
''' &param name=&aCaptionAndState&&&/param&
''' &param name=&oCell&&&/param&
''' &param name=&bInsertContentControl&&&/param&
''' &param name=&bNeedCaption&&&/param&
''' &param name=&bCheckState&&&/param&
''' &remarks&&/remarks&
Private Sub InsertOneCheckbox(ByRef oDoc As Document, ByRef aCaptionAndState As String(), ByRef oCell As Cell, ByRef bInsertContentControl As Boolean, Optional bNeedCaption As Boolean = True, Optional bCheckState As Boolean = False)
If bInsertContentControl Then
Dim oCtrl As ContentControl = oDoc.ContentControls.Add(WdContentControlType.wdContentControlCheckBox, oCell.Range)
oCtrl.SetCheckedSymbol(82, &Wingdings 2&)
oCtrl.SetUncheckedSymbol(163, &Wingdings 2&)
If bNeedCaption = False Then
oCtrl.Checked = bCheckState
oCtrl.Checked = IIf(aCaptionAndState(1) AndAlso aCaptionAndState(1).ToLower().Equals(&true&), True, False)
oDoc.ActiveWindow.Selection.MoveRight(WdUnits.wdCharacter, 2)
'oDoc.ActiveWindow.Selection.InsertAfter(& &)
oDoc.ActiveWindow.Selection.InsertAfter(aCaptionAndState(0))
oCtrl.LockContentControl = True
oCtrl.LockContents = True
Dim o As Object = oDoc.InlineShapes.AddOLEControl(&Forms.CheckBox.1&, oCell.Range).OLEFormat.Object
o.Caption = aCaptionAndState(0)
o.SpecialEffect = 0
o.Width = oCell.Width
o.Value = IIf(Not String.IsNullOrEmpty(aCaptionAndState(1)) AndAlso aCaptionAndState(1).ToLower().Equals(&true&), True, False)
o.AutoSize = True
o.Locked = True
Private Sub InsertOneRadioButton(ByRef oDoc As Document, ByRef aCaptionAndState As String(), ByRef oCell As Cell)
Dim o As Object = oDoc.InlineShapes.AddOLEControl(&Forms.OptionButton.1&, oCell.Range).OLEFormat.Object
o.Caption = aCaptionAndState(0)
o.SpecialEffect = 0
o.Width = oCell.Width
o.Value = IIf(Not String.IsNullOrEmpty(aCaptionAndState(1)) AndAlso aCaptionAndState(1).ToLower().Equals(&true&), True, False)
o.AutoSize = True
o.Locked = True
Private Sub InsertCxTableDataToTable(ByRef oDoc As Document, ByRef aBookmarkItem As String(), ByRef sBookmarkValue As String, ByRef oRange As Range, Optional ByVal bInsertContentControl As Boolean = True)
Dim rSeparator As String() = {&~|~&} 'CXTable行分隔符
Dim cSeperator As String() = {&^|^&} 'CXTable列分隔符
Dim tSperator As String() = {&-&} 'CXTable标题字段分隔符
Dim sSperator As String() = {&/&} '特殊字段分隔符
Dim iSperator As String() = {&@&} '特殊字段-索引和字段类型分隔符
'解析是否传入标题
Dim sCxData As String = &&
Dim aTableTitle As String() = Nothing
If sBookmarkValue.IndexOf(&*&) & 0 Then
sCxData = sBookmarkValue
Dim aItems As String() = sBookmarkValue.Split(&*&)
aTableTitle = aItems(0).Split(tSperator, StringSplitOptions.RemoveEmptyEntries)
sCxData = aItems(1)
If String.IsNullOrEmpty(sCxData) Then
'是否有特殊列要处理(等号拆分的第四个参数为特殊字段参数 ）
Dim aSpecialField As String() = Nothing
If aBookmarkItem.Length & 3 Then
aSpecialField = aBookmarkItem(3).Split(sSperator, StringSplitOptions.RemoveEmptyEntries)
Dim rowItems As String() = sCxData.Split(rSeparator, StringSplitOptions.RemoveEmptyEntries)
Dim iDataColCount As Integer = rowItems(0).Split(cSeperator, StringSplitOptions.None).Length
Dim bNeedTitle As Boolean = True
Dim iColCount As Integer
If aTableTitle Is Nothing OrElse aTableTitle.Length & iDataColCount Then
bNeedTitle = False
iColCount = iDataColCount
iColCount = aTableTitle.Length
Dim oTable As Table = oDoc.Tables.Add(oRange, IIf(bNeedTitle, rowItems.Length + 1, rowItems.Length), iColCount)
For i As Integer = 1 To oTable.Rows.Count
For j As Integer = 1 To oTable.Columns.Count
'插入标题
If i = 1 AndAlso bNeedTitle Then
oTable.Cell(i, j).Range.Text = aTableTitle(j - 1)
oTable.Cell(i, j).Borders.Item(WdBorderType.wdBorderBottom).LineStyle = WdLineStyle.wdLineStyleSingle
oTable.Cell(i, j).Borders.Item(WdBorderType.wdBorderBottom).LineWidth = WdLineWidth.wdLineWidth050pt
oTable.Cell(i, j).Borders.Item(WdBorderType.wdBorderBottom).Color = WdColor.wdColorAutomatic
Dim colItems As String()
If bNeedTitle Then
colItems = rowItems(i - 2).Split(cSeperator, StringSplitOptions.None)
colItems = rowItems(i - 1).Split(cSeperator, StringSplitOptions.None)
Dim sCellValue As String = colItems(j - 1)
'标题字段比数据字段多1，则第一列填充序号
If aTableTitle IsNot Nothing AndAlso aTableTitle.Length - colItems.Length = 1 Then
If j = 1 Then
oTable.Cell(i, j).Range.Text = j.ToString()
Continue For
'处理特殊字段
Dim bHasDeal As Boolean = False
If aSpecialField IsNot Nothing AndAlso aSpecialField.Length & 0 Then
For k As Integer = 0 To aSpecialField.Length - 1
Dim sItem As String = aSpecialField(k)
Dim aIndexAndType As String() = sItem.Split(iSperator, StringSplitOptions.None)
If Not String.IsNullOrEmpty(aIndexAndType(0)) AndAlso Not String.IsNullOrEmpty(aIndexAndType(1)) Then
If aIndexAndType(0) = j Then
If aIndexAndType(1) = &chk& Then
'oTable.Cell(i, j).Width = 15
'oTable.Cell(i, j).RightPadding = 0
InsertOneCheckbox(oDoc, Nothing, oTable.Cell(i, j), True, False, IIf(sCellValue.Equals(&1&), True, False))
bHasDeal = True
If bHasDeal Then
Continue For
oTable.Cell(i, j).VerticalAlignment = WdCellVerticalAlignment.wdCellAlignVerticalCenter
oTable.Cell(i, j).Range.Text = sCellValue
Catch ex As Exception
'此方法通过插入特殊字符的方式打印，没尝试成功
Private Sub InsertBookmarValueToTable(ByRef oDoc As Document, ByRef sBookmarks As String)
Dim aKeyValue As String() = sBookmarks.Split(&=&)
Dim sBookmarkName As String = aKeyValue(0)
Dim sBookmarkValue As String = aKeyValue(1)
Dim sFieldType As String = aKeyValue(2)
Dim oRange As Range = oDoc.Bookmarks.Item(sBookmarkName).Range
Dim aItems As String() = sBookmarkValue.Split(&,&)
Dim sFont As Object = Nothing
Dim uic As Object = True
Dim oMissing As Object = Reflection.Missing.Value
If sFieldType = &chk& Or sFieldType = &rdo& Then
Dim iColCount As Integer = Integer.Parse(aKeyValue(3))
If iColCount &= 0 Then
Dim iRowCount As Integer = Math.Ceiling(aItems.Length / iColCount)
Dim oTable As Table = oDoc.Tables.Add(oRange, iRowCount, iColCount)
If sFieldType = &chk& Then
sFont = &Wingdings 2&
sFieldType = &Forms.OptionButton.1&
Dim index As Integer = 0
For i As Integer = 1 To oTable.Rows.Count
For j As Integer = 1 To oTable.Columns.Count
Dim cell As Cell = oTable.Cell(i, j)
'Dim index As Integer = i * iColCount + j
If index & aItems.Length - 1 Then
Dim sItem As String = aItems(index)
index += 1
Dim aCaptionAndState As String() = sItem.Split(&|&)
'插入符号和替换都失败……
'Dim bookmarkName As String = &cell_& + index.ToString()
'Dim tempBookmark As Bookmark = oDoc.Bookmarks.Add(bookmarkName, cell.Range)
cell.Select()
'cell.Range.Text = aCaptionAndState(0)
'cell.Range.SetRange(0, 0)
'Dim unit As Object = Microsoft.Office.Interop.Word.WdUnits.wdLine
'oDoc.ActiveWindow.Selection.EndKey(unit, oMissing)
'oDoc.ActiveWindow.Selection.InsertSymbol(-4014, sFont, uic, oMissing)
'cell.Range.Collapse()
'oDoc.ActiveWindow.Selection.InsertSymbol(-4014, sFont, uic, oMissing)
'oDoc.Bookmarks.Item(bookmarkName).Range.InsertSymbol(-4014, sFont, uic, oMissing)
'cell.Range.InsertAfter(aCaptionAndState(0))
'cell.Range.MoveStart(WdUnits.wdCharacter, 1)
cell.Range.SetRange(cell.Range.Start, cell.Range.Start)
cell.Range.InsertSymbol(-4014, sFont, uic, oMissing)
'cell.Range.InsertAfter(aCaptionAndState(0))
'Wingdings 2字体下的\u0052代表打钩的选择框，\u00A3代表未打钩的选择框
'cell.Range.Text = & &
'cell.Select()
'Dim replaceAll As Object = WdReplace.wdReplaceAll
'oDoc.Application.Selection.Find.ClearFormatting()
'oDoc.Application.Selection.Find.Text = cell.Range.Text
'oDoc.Application.Selection.Find.Replacement.ClearFormatting()
'Dim sReplaceWith As String = IIf(aCaptionAndState(1) AndAlso aCaptionAndState(1).ToLower().Equals(&true&), &\0052& + aCaptionAndState(0), &\u00A3& + aCaptionAndState(0))
'oDoc.Application.Selection.Find.Replacement.Text = sReplaceWith
'Dim b As Boolean = oDoc.Application.Selection.Find.Execute(cell.Range.Text, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, oMissing, sReplaceWith, replaceAll, oMissing, oMissing, oMissing, oMissing)
ElseIf sFieldType = 1 Then
oRange.Text = sBookmarkValue
Catch ex As Exception
&&相关文章推荐
参考知识库
* 以上用户言论只代表其个人观点，不代表CSDN网站的观点或立场
访问：21736次
排名：千里之外
原创：13篇
(2)(1)(2)(1)(1)(1)(1)(1)(3)(4)(1)相关新闻 & & &