export à partir d'access vers excellRésolu

Question

bonjour,
je veux récupérer le résultat de deux requêtes dans deux feuilles excel différents, et je rencontre des problèmes , lors de l'export d'une seule requête dans une feuille ça marche bien mais je ne sait pas comment procéder pour enregistrer une requête 1 dans la première feuille et une requête 2 dans la deuxième feuille d'un même classeur.

#Region "Common Variable"

    Private conn As New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Program Files\Cheque Print\Fournisseurs.mdb;Persist Security Info=True")
    Private ComDset As New DataSet
    Private ComDset1 As New DataSet
#End Region

#Region "Common Function"
    Private Sub Load_Excel_Details()
        'Extracting from database

        Dim str, filename As String
        Dim col, row As Integer
        str = "SELECT * from historique"
        Dim adp As New OleDb.OleDbDataAdapter(str, conn)
        Try
            ComDset.Reset()
            adp.Fill(ComDset, "TTbl")
            If ComDset.Tables.Count < 0 Or ComDset.Tables(0).Rows.Count <= 0 Then
                Exit Sub
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        Dim Excel As Object = CreateObject("Excel.Application")
        If Excel Is Nothing Then
            MsgBox("Verifiez si Excel est installé.", MsgBoxStyle.Critical)
            Return
        End If


        'Export to Excel process
        Try
            With Excel
                .SheetsInNewWorkbook = 1
                .Workbooks.Add()
                .Worksheets(1).Select()

                Dim i As Integer = 1
                For col = 0 To ComDset.Tables(0).Columns.Count - 1
                    .cells(1, i).value = ComDset.Tables(0).Columns(col).ColumnName
                    .cells(1, i).EntireRow.Font.Bold = True
                    i += 1
                Next
                i = 2
                Dim k As Integer = 1
                For col = 0 To ComDset.Tables(0).Columns.Count - 1
                    i = 2
                    For row = 0 To ComDset.Tables(0).Rows.Count - 1
                        .Cells(i, k).Value = ComDset.Tables(0).Rows(row).ItemArray(col)
                        i += 1
                    Next
                    k += 1
                Next

                filename = "c:\Historique_Cheque" & Format(Now(), "dd-MM-yyyy_hh-mm-ss") & ".xlsx"
                .ActiveCell.Worksheet.SaveAs(filename)

            End With

            System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
            Excel = Nothing
            MsgBox("Le fichier est enregistré sous '" & filename & "'", MsgBoxStyle.Information)
            
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

        ' The excel is created and opened for insert value. We most close this excel using this system
        Dim pro() As Process = System.Diagnostics.Process.GetProcessesByName("EXCEL")
        For Each i As Process In pro
            i.Kill()
        Next

    End Sub
#End Region

joujma5 · Accepted Answer

J'ai réussi à trouver la solution là voila:

#Region "Common Function"
    Private Sub Load_Excel_Details()
        'Extracting from database
        'load ATB
        Dim str, filename As String
        Dim col, row As Integer
        str = "SELECT * from historique where Banque='ATB'"
        Dim adp As New OleDb.OleDbDataAdapter(str, conn)
        Try
            ComDset.Reset()
            adp.Fill(ComDset, "TTbl")
            If ComDset.Tables.Count < 0 Or ComDset.Tables(0).Rows.Count <= 0 Then
                Exit Sub
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        Dim Excel As Object = CreateObject("Excel.Application")
        If Excel Is Nothing Then
            MsgBox("Verifiez si Excel est installé.", MsgBoxStyle.Critical)
            Return
        End If

        'load biat
        Dim str1 As String
        str1 = "SELECT * from historique where Banque='BIAT'"
        Dim adp1 As New OleDb.OleDbDataAdapter(str1, conn)
        Try
            ComDset1.Reset()
            adp1.Fill(ComDset1, "TTbl1")
            If ComDset1.Tables.Count < 0 Or ComDset1.Tables(0).Rows.Count <= 0 Then
                Exit Sub
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

        'load stb
        Dim str2 As String
        str2 = "SELECT * from historique where Banque='STB'"
        Dim adp2 As New OleDb.OleDbDataAdapter(str2, conn)
        Try
            ComDset2.Reset()
            adp2.Fill(ComDset2, "TTbl2")
            If ComDset2.Tables.Count < 0 Or ComDset2.Tables(0).Rows.Count <= 0 Then
                Exit Sub
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

        'Export to Excel process
        Try
            With Excel
                .SheetsInNewWorkbook = 3
                .Workbooks.Add()
                .Worksheets(1).Select()
                Dim i As Integer = 1
                For col = 0 To ComDset1.Tables(0).Columns.Count - 1
                    .cells(1, i).value = ComDset1.Tables(0).Columns(col).ColumnName
                    .cells(1, i).EntireRow.Font.Bold = True
                    i += 1
                Next
                i = 2
                Dim k As Integer = 1
                For col = 0 To ComDset1.Tables(0).Columns.Count - 1
                    i = 2
                    For row = 0 To ComDset1.Tables(0).Rows.Count - 1
                        .Cells(i, k).Value = ComDset1.Tables(0).Rows(row).ItemArray(col)
                        i += 1
                    Next
                    k += 1

                Next

                .Worksheets(2).Select()
                Dim i1 As Integer = 1
                For col = 0 To ComDset.Tables(0).Columns.Count - 1
                    .cells(1, i1).value = ComDset.Tables(0).Columns(col).ColumnName
                    .cells(1, i1).EntireRow.Font.Bold = True
                    i1 += 1
                Next
                i1 = 2
                Dim k1 As Integer = 1
                For col = 0 To ComDset.Tables(0).Columns.Count - 1
                    i1 = 2
                    For row = 0 To ComDset.Tables(0).Rows.Count - 1
                        .Cells(i1, k1).Value = ComDset.Tables(0).Rows(row).ItemArray(col)
                        i1 += 1
                    Next
                    k1 += 1

                Next

                .Worksheets(3).Select()
                Dim i2 As Integer = 1
                For col = 0 To ComDset2.Tables(0).Columns.Count - 1
                    .cells(1, i2).value = ComDset2.Tables(0).Columns(col).ColumnName
                    .cells(1, i2).EntireRow.Font.Bold = True
                    i2 += 1
                Next
                i2 = 2
                Dim k2 As Integer = 1
                For col = 0 To ComDset2.Tables(0).Columns.Count - 1
                    i2 = 2
                    For row = 0 To ComDset2.Tables(0).Rows.Count - 1
                        .Cells(i2, k2).Value = ComDset2.Tables(0).Rows(row).ItemArray(col)
                        i2 += 1
                    Next
                    k2 += 1

                Next

                filename = "c:\Historique_Cheque.xlsx"
                .ActiveCell.Worksheet.SaveAs(filename)

            End With

            System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
            Excel = Nothing
            MsgBox("Le fichier est enregistré sous '" & filename & "'", MsgBoxStyle.Information)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        ' The excel is created and opened for insert value. We most close this excel using this system
        Dim pro() As Process = System.Diagnostics.Process.GetProcessesByName("EXCEL")
        For Each i As Process In pro
            i.Kill()
        Next

    End Sub

#End Region

Export à partir d'access vers excell

1 réponse

Votre réponse

Discussions similaires