06毕业设计
来源:互联网 发布:linux tar压缩文件夹 编辑:程序博客网 时间:2024/05/22 06:57
If rs1.RecordCount < 1 Then
MsgBox "导出失败,当前列表中没有记录!"
outstate1.Visible = False
Exit Sub
End If
On Error GoTo not_installword '当没装word软件时的出错处理
If MsgBox(Chr(13) + "是否将当前列表中的数据导出为WORD数据? ", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Dim wdApp As Word.Application '定义word变量
Dim wdDoc '定义word文档变量
Dim wdTable '定义WORD表格变量
Dim FieldLen() '存放字段长度值
Dim FieldLen1 As Integer '存放每列的最大宽度
Dim FieldValue As String
Dim iRow, iCol As Integer
Dim iRowCount, iColCount As Integer '存放行数、列数值
main.Enabled = False
outstate1.Visible = True '显示导出状态
outstate1.Caption = "正在导出,请稍后..."
With rs1
.MoveLast
iRowCount = .RecordCount + 2 '记录总数
iColCount = .Fields.Count '字段总数
.MoveFirst
End With
'重新定义列数
ReDim FieldLen(iColCount)
'添加一个word文档及表
Set wdApp = New Word.Application
wdApp.Documents.Add '新建Word 文档
Set wdTable = wdApp.Selection.Tables.Add(wdApp.Selection.Range, iRowCount + 1, iColCount, wdWord9TableBehavior, wdAutoFitFixed)
With rs1
'读取标题宽度作为列宽初始值
For iCol = 1 To iColCount
FieldLen(iCol) = LenB(StrConv(.Fields(iCol - 1).Name, vbFromUnicode))
Next iCol
For iRow = 1 To iRowCount
For iCol = 1 To iColCount
'读取字段值,返回为文本型
If .Fields(iCol - 1).Value <> "" Then
If .Fields(iCol - 1).Type = 10 Then
FieldValue = Trim(.Fields(iCol - 1).Value)
Else
FieldValue = CStr(.Fields(iCol - 1).Value)
End If
Else
FieldValue = " "
End If
Select Case iRow
Case 1
'第一行为标题行,在后面设置
Case 2 '在第二行插入字段名
wdTable.Cell(iRow, iCol).Range.InsertAfter (.Fields(iCol - 1).Name)
'设置字段名居中
wdTable.Cell(iRow, iCol).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
'设置字体为粗体
wdTable.Cell(iRow, iCol).Range.Font.Bold = wdToggle
Case Else '从第三行开始插入记录
'计算字段值长度,返回值的单位是字节长度
FieldLen1 = LenB(StrConv(FieldValue, vbFromUnicode))
'自动设置表格列宽
If FieldLen(iCol) < FieldLen1 Then
'表格列宽等于较长字段长
wdTable.Columns(iCol).PreferredWidth = 8 * FieldLen1 'Word表
'数组Fieldlen(iCol)中存放最大字段长度值
FieldLen(iCol) = FieldLen1
Else
'表格列宽等于当前字段宽度
wdTable.Columns(iCol).PreferredWidth = 8 * FieldLen(iCol)
End If
'向表单元格中写入字段值
wdTable.Cell(iRow, iCol).Range.InsertAfter (FieldValue)
'设置单元格中的字居中
wdTable.Cell(iRow, iCol).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Select
DoEvents
Next iCol
If iRow > 2 Then
If Not .EOF Then .MoveNext
End If
DoEvents
outstate1.Caption = "正在导出,完成: " + CStr(Int(100 * iRow / iRowCount)) + "%" '显示导出进度
Next iRow
'添加年月日
wdTable.Cell(iRowCount + 1, 1).Range.InsertAfter (Format$(Now, "yyyy年mm月dd日")) '在最后一行后加是年月日
wdTable.Rows(iRowCount + 1).Cells.Merge '合并最后一行
wdTable.Cell(iRowCount + 1, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
wdTable.Rows(1).Cells.Merge '合并第一行表格
If usetype = "系统管理员" Then
wdTable.Cell(1, 1).Range.InsertAfter ("标题名") '合并以后插入标题
Else
wdTable.Cell(1, 1).Range.InsertAfter (usepart & "标题名") '合并以后插入标题
End If
wdTable.Cell(1, 1).Range.Font.Bold = wdToggle '设置标题为粗体
wdTable.Cell(1, 1).Range.Font.Size = 14 '设置标题为14号字体
wdTable.Cell(1, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter '设置标题居中
wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter '设置表格居中
.MoveFirst
wdApp.Visible = True '显示Word表格
Set wdApp = Nothing '交还控制给Word
End With
outstate1.Visible = False
main.Enabled = True
Exit Sub
not_installword: '当电脑没装word时的处理
MsgBox "导出错误!请检查电脑是否装有不低于Word2000版本的Word软件!" & Chr(13) & Chr(10) & "然后检查一下出错处的记录是否有问题!"
outstate1.Visible = False
main.Enabled = True
End Sub
- 06毕业设计
- 06毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- 毕业设计
- layer常用提示框用法
- c# 书
- 无效的 CurrentPageIndex 值。它必须大于等于 0 且小于 PageCount。
- C# 交替显示项的DataGird,鼠标上移时转变颜色,退出后能恢复原来颜色
- SpringMVC 文件上传配置,多文件上传,使用的MultipartFile
- 06毕业设计
- 06毕业设计
- 重写了loadView,一般用在什么地方
- C#邮件发送
- android 基于HTTPSWebview无法正常加载图片
- iOS开发——创建你自己的Framework
- 2007.08.23 C#工作随笔
- 2007.08.24 C#工作随笔
- C# 数组导入