1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
| Imports System.Data.SqlClient
Module Module1
Dim con_strg As String = "Data Source=Neptune;Initial catalog=absyss;Integrated Security=SSPI"
Sub ChargeTable(ByVal requete As String, ByVal nomtable As String, ByVal data As System.Data.DataSet)
Dim con As New SqlConnection()
Dim sqlda As SqlDataAdapter
con = New SqlConnection(con_strg)
con.Open()
sqlda = New SqlDataAdapter(requete, con)
Try
' Récupération des données dans une table nomtable
sqlda.Fill(data, nomtable)
Catch ex As Exception
MsgBox(ex.ToString)
Finally
con.Close()
End Try
End Sub
Sub ChargeTable1(ByVal requete2 As String, ByVal nomtable As String, ByVal data2 As System.Data.DataSet)
Dim con As New SqlConnection()
Dim sqlda As SqlDataAdapter
con = New SqlConnection(con_strg)
con.Open()
sqlda = New SqlDataAdapter(requete2, con)
Try
' Récupération des données dans une table nomtable
sqlda.Fill(data2, nomtable)
Catch ex As Exception
MsgBox(ex.ToString)
Finally
con.Close()
End Try
End Sub
Sub rapport_excel(ByVal requete As String, ByVal requete2 As String)
'Création du DataSet contact
Dim data As New Data.DataSet()
Try
ChargeTable(requete, "RECHERCHE", data)
Catch ex As Exception
MsgBox(ex.ToString)
Exit Sub
End Try
'Ici on compte le nombre de lignes et de colonnes du datatable
Dim NbRow As Integer = 0
Try
NbRow = data.Tables("RECHERCHE").Rows.Count
Catch ex As Exception
End Try
Dim nbcol As Integer = data.Tables("RECHERCHE").Columns.Count
'Création du DataSet role
Dim data2 As New Data.DataSet()
Try
ChargeTable1(requete2, "RECHERCHE", data2)
Catch ex As Exception
MsgBox(ex.ToString)
Exit Sub
End Try
'Ici on compte le nombre de lignes et de colonnes du datatable
Dim NbRow2 As Integer = 0
Try
NbRow2 = data2.Tables("RECHERCHE").Rows.Count
Catch ex As Exception
End Try
Dim nbcol2 As Integer = data2.Tables("RECHERCHE").Columns.Count
'proc_xsl_avant recupére tous les processus Excel avant la création de notre processus excel
Dim proc_xsl_avant() As System.Diagnostics.Process = System.Diagnostics.Process.GetProcessesByName("Excel")
Dim proc As System.Diagnostics.Process
'compte le nombre de processus
Dim nbproc_av As Integer = 0
nbproc_av = proc_xsl_avant.Length
'tableau contenant les id des processus
Dim proc_xsl_id(nbproc_av) As String
Dim i As Integer
For i = 0 To nbproc_av - 1
proc = proc_xsl_avant(i)
proc_xsl_id(i) = proc.Id.ToString
Next
'Variables utiles pour le fichier excel
Dim xlApp As New Excel.Application
'On recupére tous les processus excel
Dim proc_xsl() As System.Diagnostics.Process = System.Diagnostics.Process.GetProcessesByName("Excel")
Dim nbproc As Integer
nbproc = proc_xsl.Length
Dim id(nbproc) As String
For i = 0 To nbproc - 1
proc = proc_xsl(i)
id(i) = proc.Id.ToString
Next
'On recupére le id correspondant au processus que l'on vient de créer
Dim mon_id As String = ""
Dim trouver As Boolean
Dim j As Integer
i = 0
While i < nbproc
j = 0
trouver = False
While trouver = False And i < nbproc And j < nbproc_av
If id(i) = proc_xsl_id(j) Then
trouver = True
End If
j = j + 1
End While
If trouver = False Then
mon_id = id(i)
End If
i = i + 1
End While
Dim x As Integer
Dim y As Integer
Dim xlSheet As New Excel.Worksheet
xlSheet = xlApp.Workbooks.Add.ActiveSheet
xlSheet.Name = "toto"
End Sub
For y = 0 To nbcol - 1
For x = 0 To NbRow - 1
'En tête
xlSheet.Cells(1, y + 1) = Data.Tables("RECHERCHE").Columns(y).ColumnName
'On rempli la case
xlSheet.Cells(x + 2, y + 1) = Data.Tables("RECHERCHE").Rows(x).Item(y).ToString
End If
Next
Next
xlSheet.SaveAs("C:\toto.xls")
xlSheet = Nothing
'On quitte l'application et on détruit les objets
xlApp.Quit()
xlApp = Nothing
'Kill notre processus Excel
For i = 0 To nbproc - 1
proc = proc_xsl(i)
If proc.Id = mon_id Then
proc.Kill()
End If
Next
GC.Collect()
End Function
End Module |
Partager