wtuqi
2/22/2020 - 6:47 AM
Office操作
'获取Excel表结构（含获取表名数组）
Public Function GetExcelSchema(excelFileName As String) As Boolean
Dim tableName As String = Nothing
If System.IO.File.Exists(excelFileName) Then
'"Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties='Excel 8.0;IMEX=1';
Using conn As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;IMEX=1';Data Source=" + excelFileName)
conn.Open()
'获取Excel结构
Dim dt As DataTable = conn.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, Nothing)
'获取表名数组
For i = 0 To dt.Rows.Count - 1
ToolStripComboBox1.Items.Add(dt.Rows(i)(2).ToString.Split("$")(0).Replace("'", ""))
Next
End Using
End If
Return True
End Function//读取Excel
Imports System.Data.OleDb
Public Class Exc
Public MyCon As New OleDbConnection
Public MyCom As OleDbCommand
Public MyAdapter As OleDbDataAdapter
Public Dt As DataTable
Public Dr As OleDbDataReader
#Region "连接"
Public Sub Excon(ByVal FileName As String)
Dim Substr As String = Nothing
Substr = FileName.Substring(FileName.Length - 4, 4) '截取后4位
Select Case Substr '以后四位的格式来决定连接字符
Case ".xls" ' OFFICE97-2003(.xls)
MyCon.ConnectionString = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties='Excel 8.0;IMEX=1';", FileName)
Case "xlsb" ' OFFICE2007-2010(.xlsx|.xlsb)
MyCon.ConnectionString = String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties='Excel 12.0;IMEX=1';", FileName)
Case "xlsx" ' OFFICE2007-2010(.xlsx|.xlsb)
MyCon.ConnectionString = String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties='Excel 12.0;IMEX=1';", FileName)
Case "xlsm" ' OFFICE2007-2010启用宏的 Excel(.xlsm)
MyCon.ConnectionString = String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties='Excel 12.0 宏 ;IMEX=1';", FileName)
End Select
'Select Case Cla'自定义方式
' Case 0 ' OFFICE97-2003(.xls)
' MyCon.ConnectionString = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties='Excel 8.0;IMEX=1';", Constr)
' Case 1 ' OFFICE2007-2010(.xlsx|.xlsb)
' MyCon.ConnectionString = String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties='Excel 12.0;IMEX=1';", Constr)
' Case 2 ' OFFICE2007-2010启用宏的 Excel(.xlsm)
' MyCon.ConnectionString = String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties='Excel 12.0 宏 ;IMEX=1';", Constr)
'End Select
End Sub
Public Sub Open()
MyCon.Open()
End Sub
Public Sub Close()
MyCon.Close()
End Sub
#End Region
#Region "数据读取"
'读取数据到DataReader
Public Function Ex_DateRead(ByVal TabelName As String, ByVal ColumnName As String, ByVal Inputval As String) As OleDbDataReader
MyCom = New OleDbCommand
MyCom.CommandText = String.Format("SELECT * FROM [{0}$] where [{1}] = '{2}' ", TabelName, ColumnName, Inputval)
MyCom.Connection = MyCon
Dr = MyCom.ExecuteReader
Return Dr
End Function
'读取数据到DataTable,用于显示数据到DataGrid这些控件
Public Function Ex_ReadDT(ByVal TabelName As String, ByVal ColumnName As String, ByVal Inputval As String) As DataTable
Dt = New DataTable
MyCom = New OleDb.OleDbCommand
MyCom.Connection = MyCon
MyCom.CommandText = String.Format("SELECT * FROM [{0}$] where [{1}] = '{2}' ", TabelName, ColumnName, Inputval)
MyAdapter = New OleDb.OleDbDataAdapter
MyAdapter.SelectCommand = MyCom
MyAdapter.Fill(Dt)
Return Dt
End Function
Public Function ReadTableALL(ByVal TabelName As String) As DataTable
Dt = New DataTable
MyCom = New OleDb.OleDbCommand
MyCom.Connection = MyCon
MyCom.CommandText = String.Format("SELECT * FROM [{0}$]", TabelName)
MyAdapter = New OleDb.OleDbDataAdapter
MyAdapter.SelectCommand = MyCom
MyAdapter.Fill(Dt)
Return Dt
End Function
#End Region//读取Word
'引用该组件Microsoft.Office.Interop.Word并且设置该组件《嵌入互操作类型》为false
Imports word = Microsoft.Office.Interop.Word
'读方法一
If OpenFileDialog1.ShowDialog = DialogResult.OK Then
Dim wdApp As New Word.Application
Dim wdDoc As New Word.Document
wdDoc = wdApp.Documents.Open(OpenFileDialog1.FileName)
Dim myText As String = wdDoc.Range.Text
RichTextBox1.Text = myText
wdDoc.Close()
wdApp.Quit()
End If
'使用
If OpenFileDialog1.ShowDialog = DialogResult.OK Then
OpenWord(OpenFileDialog1.FileName, RichTextBox1)
End If
Public Sub OpenWord(fileName As String, RtBox As RichTextBox)
Dim app As New word.ApplicationClass
Dim doc As word.Document = Nothing
Dim missing As Object = System.Reflection.Missing.Value
Dim File As Object = fileName
Dim [readOnly] As Object = False
Dim isVisible As Object = True
Try
'doc = app.Documents.Open(File, missing, [readOnly], missing, missing, missing,
'missing, missing, missing, missing, missing, isVisible,
'missing, missing, missing, missing)
doc = app.Documents.Open(File, missing, [readOnly], missing, missing, missing, isVisible, missing)
doc.ActiveWindow.Selection.WholeStory()
'全选word文档中的数据
doc.ActiveWindow.Selection.Copy()
'复制数据到剪切板
'richTextBox粘贴数据
'richTextBox1.Text = doc.Content.Text;//显示无格式数据
RtBox.Paste()
Finally
If doc IsNot Nothing Then
doc.Close(missing, missing, missing)
doc = Nothing
End If
If app IsNot Nothing Then
app.Quit(missing, missing, missing)
app = Nothing
End If
End Try
End Sub
'另存为
Public Sub SaveAsWord(fileName As String， RtBox As RichTextBox)
Dim app As New word.ApplicationClass()
Dim doc As word.Document = Nothing
Dim missing As Object = System.Reflection.Missing.Value
Dim File As Object = fileName
Try
doc = app.Documents.Add(missing, missing, missing, missing)
doc.ActiveWindow.Selection.WholeStory()
'全选
RtBox.SelectAll()
Clipboard.SetData(DataFormats.Rtf, RtBox.SelectedRtf)
'复制RTF数据到剪贴板
doc.ActiveWindow.Selection.Paste()
doc.SaveAs(File, missing, missing, missing, missing, missing,
missing, missing, missing, missing, missing, missing,
missing, missing, missing, missing)
Finally
If doc IsNot Nothing Then
doc.Close(missing, missing, missing)
doc = Nothing
End If
If app IsNot Nothing Then
app.Quit(missing, missing, missing)
app = Nothing
End If
End Try
End Sub
End ClassImports Microsoft.Office.Interop.Excel'需要引用
‘并引用Office2003文件至工程 Interop.Excel.dll和Interop.Microsoft.Office.Interop.Excel.dll
'Dim Appexcel As Excel.Application = New Excel.Application '报表调用必须声明
Dim Appexcel As New Microsoft.Office.Interop.Excel.Application()
'Appexcel.Application.Workbooks.Add(True)
Appexcel.Visible = True
'Dim Appexcel As Microsoft.Office.Interop.Excel.Workbook = Excel.Workbooks.Add(True)
Dim Gi As Integer '录入行变量
Dim Di As Integer = Me.DataGridView1.RowCount 'DataGridView1.VisibleRowCount
Appexcel.Visible = True '显示EXCEL表格
Appexcel.Application.Workbooks.Open(Sytem.AppPath & "\TEMP.XLT")
'For Gi = 2 To Di - 2
' With Appexcel
' .Cells(Gi + 6, 1) = DataGridView1.Item(Gi, 6)
' .Cells(Gi + 6, 2) = DataGridView1.Item(Gi, 1)
' Sys.Dt.Rows.RemoveAt(Gi + 2)
' End With
'Next Gi
'Dim q = From row In Sys.Dt.AsEnumerable
' Group row By dateGroup = New With {
' Key .Code = Convert.ToInt64(row.Field(Of Double?)("c_id_code")),
' Key .p_name = row.Field(Of String)("p_name")
' } Into Group
' Select New With {
' Key .Dates = dateGroup.Code,
' Key .p_name = dateGroup.p_name}
Dim DV As System.Data.DataTable = Rexcel.Sel(Sys.Dt)
With Appexcel
For i As Integer = 0 To DV.Rows.Count - 3
For j As Integer = 0 To DV.Columns.Count - 1
.Cells(i + 5, j + 2) = DV.Rows(i)(j).ToString()
Next
Next
End With
Appexcel.Quit()'参考VS2008农合工程
Private Sub Create_excel() '创建EXCEL过程
Dim Gi As Integer '录入行变量
Dim Di As Integer = DataGrid1.VisibleRowCount
If Di > 15 Then
MsgBox("按要求EXCEL只需要15条数据,15条以下数据请重新创建", MsgBoxStyle.Information)
Di = 16
End If
Dim Appexcel As Excel.Application = New Excel.Application '报表调用必须声明
'Appexcel.Visible = True '显示EXCEL表格
Appexcel.Application.Workbooks.Open(Path.GetDirectoryName(Application.ExecutablePath) & "\Nh.XLT")
For Gi = 0 To Di - 2
With Appexcel
.Cells(Gi + 6, 1) = DataGrid1.Item(Gi, 6) '农合证号
.Cells(Gi + 6, 2) = DataGrid1.Item(Gi, 1) '户主姓名
.Cells(Gi + 6, 3) = DataGrid1.Item(Gi, 2) '患者姓名
.Cells(Gi + 6, 4) = DataGrid1.Item(Gi, 3) '性别
.Cells(Gi + 6, 5) = DataGrid1.Item(Gi, 4) '年龄
.Cells(Gi + 6, 6) = DataGrid1.Item(Gi, 12) '入院时间
.Cells(Gi + 6, 7) = DataGrid1.Item(Gi, 13) '出院时间
.Cells(Gi + 6, 9) = (Val(DataGrid1.Item(Gi, 16)) + Val(DataGrid1.Item(Gi, 19))) '药费
.Cells(Gi + 6, 10) = DataGrid1.Item(Gi, 25) '检查费
.Cells(Gi + 6, 11) = DataGrid1.Item(Gi, 28) '特检费
.Cells(Gi + 6, 12) = DataGrid1.Item(Gi, 31) '手术费
.Cells(Gi + 6, 13) = DataGrid1.Item(Gi, 40) '治疗费
.Cells(Gi + 6, 14) = Val(DataGrid1.Item(Gi, 22)) + Val(DataGrid1.Item(Gi, 34)) + Val(DataGrid1.Item(Gi, 37)) + Val(DataGrid1.Item(Gi, 43)) + Val(DataGrid1.Item(Gi, 46)) + Val(DataGrid1.Item(Gi, 49)) '其它费
.Cells(Gi + 6, 15) = DataGrid1.Item(Gi, 15) '报销费
.Cells(Gi + 6, 19) = DataGrid1.Item(Gi, 9) '住址
Mdataset.Tables.RemoveAt(Gi + 2)
End With
Next Gi
Appexcel.Application.ActiveWorkbook.SaveAs(SaveFileDialog1.FileName & ".xls") '另存为命令
Appexcel.Application.Workbooks.Close() '关闭当前文档
Appexcel.Application.Quit() '退出EXCEL该处是重点
MsgBox("EXCEL报表创建成功!", MsgBoxStyle.Information) '一定要当报表完成后才能重新开始获控制权
End Sub