MyTetra Share
Делитесь знаниями!
Получить доступ к листу Excel и прочитать данные - Visual Basic .NET
31.07.2019
22:37
Текстовые метки: рекордсет, recordset
Раздел: !Закладки - VBA

Получить доступ к листу Excel и прочитать данные - Visual Basic .NET

http://www.cyberforum.ru/vb-net/thread453716.html

Module mdlExcel

Dim SelectedSheet As String

Public Sub OpenSheet(ByVal Grid As DataGridView)

Dim OpenDialog As New OpenFileDialog, FileName As String = ""

With OpenDialog

.Title = "Открыть документ Excel"

.Filter = "Документы Excel|*.xls;*.xlsx"

If .ShowDialog = Windows.Forms.DialogResult.OK Then

FileName = .FileName : Application.DoEvents()

Else

Return

End If

End With

' Подключение к Excel.

Dim connection As OleDb.OleDbConnection, connectionString As String

Try

'Для Excel 12.0

connectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" + FileName + "; Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

connection = New OleDb.OleDbConnection(connectionString)

connection.Open()

Catch ex12 As Exception

Try

'Для более ранних версий

connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + FileName + "; Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

connection = New OleDb.OleDbConnection(connectionString)

connection.Open()

Catch ex11 As Exception

MsgBox("Неизвестная версия Excel или файл имеет неизвестный формат!", MsgBoxStyle.Exclamation)

Return

End Try

End Try

'Отобразить форму выбора листов

ShowSelectForm(GetExcelSheetNames(connection), FileName)

If SelectedSheet Is Nothing Then Return

'Выборка данных

Dim command As OleDb.OleDbCommand = connection.CreateCommand()

command.CommandText = "Select * From [" & SelectedSheet & "$]"

Dim Adapter As New OleDb.OleDbDataAdapter(command), Table As New DataTable

Adapter.Fill(Table) : connection.Close()

With Grid

.Visible = False : .Parent.Cursor = Cursors.WaitCursor

.DataSource = Table : SetGridSettings(Grid)

.Visible = True : .Parent.Cursor = Cursors.Default

End With

End Sub

Private Function GetExcelSheetNames(ByVal connection As OleDb.OleDbConnection) As String()

Dim Table As DataTable

Try

Table = connection.GetOleDbSchemaTable(OleDb.OleDbSchemaGuid.Tables, New Object() {Nothing, Nothing, Nothing, "TABLE"})

If Table Is Nothing Then Return Nothing

With Table

Dim i As Integer = 0, SheetsArray() As String = Nothing, s As String

For n As Integer = 0 To .Rows.Count - 1

s = .Rows(n).Item("TABLE_NAME").ToString.Trim(New Char() {"'"})

If Strings.Right(s, 1) = "$" Then

ReDim Preserve SheetsArray(i)

SheetsArray(i) = s.Trim(New Char() {"$"})

i += 1

End If

Next

Table.Dispose() : Return SheetsArray

End With

Catch ex As Exception

MsgBox(ex.Message, MsgBoxStyle.Exclamation)

Return Nothing

End Try

End Function

Private Sub ShowSelectForm(ByVal Sheets() As String, ByVal FileName As String)

If Sheets Is Nothing Then SelectedSheet = Nothing : Return

Dim F As New Form, T As New TreeView, I As New ImageList, P As New Panel, B1, B2 As New Button

With I

.ColorDepth = ColorDepth.Depth32Bit

.ImageSize = New Size(16, 16)

.Images.Add("Книга", My.Resources.Images16x16.Excel) 'рисунок 16x16 px для названия файла excel

.Images.Add("Документ", My.Resources.Images16x16.Документ) 'рисунок 16x16 px для названия листа excel

End With

With T

.Name = "T"

.ImageList = I : .Font = New Font("Arial", 10, FontStyle.Bold)

.ShowPlusMinus = False : .ShowLines = False : .ShowRootLines = False

Dim N As TreeNode = .Nodes.Add("Книга", FileIO.FileSystem.GetName(FileName), 0, 0)

Dim nn As TreeNode

For ni As Int16 = 0 To Sheets.Length - 1

nn = N.Nodes.Add("Лист" & ni.ToString, Sheets(ni), 1, 1)

nn.NodeFont = New Font(.Font, FontStyle.Regular)

Next

.ExpandAll()

End With

With F

.Text = " Документ Excel"

.ShowInTaskbar = False

.StartPosition = FormStartPosition.CenterParent

.FormBorderStyle = FormBorderStyle.FixedToolWindow

.Height = .Height * 1.3

.AcceptButton = B1 : .CancelButton = B2

With P

.Name = "P" : .Parent = F

.Dock = DockStyle.Bottom

End With

With T

.Parent = F

.Dock = DockStyle.Fill

.BringToFront()

AddHandler .NodeMouseDoubleClick, AddressOf T_NodeDoubleClick

End With

With B2

.Name = "B2"

.Text = "Отмена"

.Parent = P : .Top = 5

.Left = P.Width - .Width - 5

AddHandler .Click, AddressOf B2_Click

End With

With B1

.Name = "B1"

.Text = "Открыть"

.Parent = P : .Top = 5

.Left = B2.Left - .Width - 5

.Font = New Font(.Font, FontStyle.Bold)

AddHandler .Click, AddressOf B1_Click

End With

P.Height = B1.Height + 10

AddHandler .Load, AddressOf F_Load

.ShowDialog()

End With

End Sub

Private Sub SetGridSettings(ByVal Grid As DataGridView)

With Grid

.ReadOnly = False : .MultiSelect = False

.SelectionMode = DataGridViewSelectionMode.CellSelect

.RowTemplate.Resizable = DataGridViewTriState.False

.RowHeadersWidthSizeMode = DataGridViewRowHeadersWidthSizeMode.DisableResizing

For n As Integer = 0 To .ColumnCount - 1

With .Columns(n)

.Resizable = DataGridViewTriState.False

.AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells

.SortMode = DataGridViewColumnSortMode.NotSortable

End With

Next

End With

End Sub

Private Sub F_Load(ByVal sender As Form, ByVal e As EventArgs)

Dim T As TreeView = sender.Controls("T")

With T

.Select()

If .Nodes(0).Nodes.Count > 0 Then .SelectedNode = .Nodes(0).Nodes(0)

End With

SelectedSheet = Nothing

End Sub

Private Sub B1_Click(ByVal sender As Button, ByVal e As EventArgs)

Dim F As Form = sender.Parent.Parent, T As TreeView = F.Controls("T")

Application.DoEvents()

If Strings.Left(T.SelectedNode.Name, 4) = "Лист" Then

F.DialogResult = DialogResult.OK

SelectedSheet = T.SelectedNode.Text : F.Close()

Else

MsgBox("Необходимо выбрать лист.", MsgBoxStyle.Exclamation)

T.Select()

End If

End Sub

Private Sub B2_Click(ByVal sender As Button, ByVal e As EventArgs)

Dim F As Form = sender.Parent.Parent

F.DialogResult = DialogResult.Cancel

SelectedSheet = Nothing : F.Close()

End Sub

Private Sub T_NodeDoubleClick(ByVal sender As TreeView, ByVal e As TreeNodeMouseClickEventArgs)

If e.Node.Name = "Книга" Then sender.ExpandAll()

B1_Click(sender.Parent.Controls("P").Controls("B1"), Nothing)

End Sub

End Module

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования