Ceci est mon premier soft VB, il sert à interroger notre base SQL par date de livraison (par DateTimePicker) ou selon 3 autres critères (dans un ComboBox) en recherche libre. Le résultat de la requête est chargé dans un DataGrid avec une possibilité de l'exporter dans Excel.
Le code est inspiré de ce que j'ai trouvé ici, je le poste pour avoir en un seul exemple ces diverses fonctions (j'ai du consulter bon nombre de forums et de sources pour y trouver réponse à mes questions et j'ai du également faire un travail de conversion car ces réponses ne concernaient pas VB 2005).
Source / Exemple :
Imports System
Imports System.Data
Imports System.Data.SqlClient
Imports Excel
Public Class Form1
Inherits System.Windows.Forms.Form
Public conn As SqlConnection
Public CmdS As SqlCommand
Public da As SqlDataAdapter
Public ds As New DataSet()
Dim Appli As New Excel.Application
Public strSql As String ' Requête SQL
Dim Ligne As DataRow
Dim Colonne As DataColumn
Public Poids As Integer ' Poids des listes
Public DateForm As String ' Date formatée pour affichage
Public JJ As String ' Jour
Public MM As String ' Mois
Public AA As String ' Année
Public AMJ As String ' Année, mois, jour
Public NomCol(11) As String ' Noms des entêtes de colonnes
Public i As Short ' Compteur
Public j As Short ' Compteur
Public Dossier As String ' Nom du Dossier
Public Selindex As Short = 99 ' Mémorisation de l'index du combobox
Public TestPgB As Short ' Remplissage ou vidage du ProgressBar
Public StepPgB As Short ' Incrément de l'affichage du ProgressBar
Public RestPgB As Short ' Compléter l'affichage du ProgressBar à la fin du traitement
' Paramètres de la connexion à SQL
Public strConn As String = "Initial Catalog=FAVRE;Data Source=Serveur-corc;User ID=sa;Password=;"
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
' Fermeture connexion et vidage DataSet + DataAdapter
Try
conn.Close()
Catch ex As Exception
End Try
Try
ds.Clear()
ds.Dispose()
ds.Reset()
Catch ex As Exception
End Try
Try
da.Dispose()
Catch ex As Exception
End Try
' Fermeture de l'application
Appli.DisplayAlerts = True
Appli.Visible = False
Appli.Quit()
Me.Close()
End Sub
Private Sub DateTimePicker1_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DateTimePicker1.ValueChanged
' Initialisation des champs inutiles avec sélection par date
ComboBox1.Text = ""
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
' Vidage avant réutilisation du Form
Try
conn.Close()
Catch ex As Exception
End Try
Try
ds.Clear()
ds.Dispose()
ds.Reset()
Catch ex As Exception
End Try
Try
da.Dispose()
Catch ex As Exception
End Try
' Formatage date pour la requête --> AAAAMMJJ
AMJ = DateTimePicker1.Value
JJ = AMJ.Substring(0, 2)
MM = AMJ.Substring(3, 2)
AA = AMJ.Substring(6, 4)
AMJ = AA & MM & JJ
' Commande SQL pour sélection par date
String_SQL()
strSql = strSql & "WHERE R.DELIVASKED = '" & AMJ & "' AND D.RC_NUM <> 1"
TestPgB = 99
StepPgB = 2
Connexion(strConn, strSql)
MiseForme()
End Sub
Private Sub Connexion(ByVal strConn As String, ByVal strSql As String)
' Connexion à SQL et chargement DataSet
conn = New SqlConnection(strConn)
conn.Open()
P_Bar(ProgressBar1)
CmdS = New SqlCommand(strSql)
da = New SqlDataAdapter(CmdS)
CmdS.Connection() = conn
P_Bar(ProgressBar1)
da.Fill(ds, "REF_PS")
P_Bar(ProgressBar1)
End Sub
Private Sub MiseForme()
NomCol(0) = "DOSSIER"
NomCol(1) = "N° CLIENT"
NomCol(2) = "SÉQUENCE"
NomCol(3) = "NOM CLIENT"
NomCol(4) = "CHANTIER"
NomCol(5) = "LOCALITÉ CHANTIER"
NomCol(6) = "ADRESSE LIVRAISON"
NomCol(7) = "LOCALITÉ LIVRAISON"
NomCol(8) = "N° LISTE INGÉNIEUR"
NomCol(9) = "POIDS (KG)"
NomCol(10) = "DATE LIVRAISON"
NomCol(11) = "S/D"
Poids = 0
' Choix de la police du DataGrid
Dim Fo As New System.Drawing.Font("Arial", 8)
DataGridView1.Font = Fo
' Total des poids (en kg) et format date pour DataGrid -- JJ/MM/AAAA
With ds.Tables("REF_PS")
For i = 0 To .Rows.Count - 1
P_Bar(ProgressBar1)
Poids = Poids + .Rows(i).Item("FABWEIGHT")
DateForm = .Rows(i).Item("DELIVASKED")
JJ = DateForm.Substring(6, 2)
MM = DateForm.Substring(4, 2)
AA = DateForm.Substring(0, 4)
DateForm = JJ & "/" & MM & "/" & AA
.Rows(i).Item("DELIVASKED") = DateForm
Next
End With
' Renommer les entêtes de colonnes du DataSet
With ds.Tables("REF_PS")
For i = 0 To .Columns.Count - 1
.Columns(i).ColumnName = NomCol(i)
Next
End With
' Chargement du DataGrid depuis le DataSet
Dim Vue As New DataView(ds.Tables("REF_PS"))
P_Bar(ProgressBar1)
DataGridView1.DataSource = Vue
' Affichage du poids sur le Form (en tonne)
Poids = Poids / 1000
TextBox3.Text = Poids
' Terminer le remplissage du ProgressBar
If RestPgB = 100 Then
Exit Sub
End If
StepPgB = 100 - RestPgB
TestPgB = 0
P_Bar(ProgressBar1)
End Sub
Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
' Mémorisation de l'index du combobox
' se fait lors du choix dans le combobox
Selindex = ComboBox1.SelectedIndex
' initialisation du champ "Recherche" pour éviter une recherche sur tout
TextBox2.Text = " "
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
' Selindex = 99 pour éviter de valider si aucun critère choisi
If Selindex = 99 Then
MsgBox("***** VOUS DEVEZ CHOISIR QUEL EST LE CRITÈRE D'INTERROGATION *****")
Exit Sub
End If
' Contrôle que le champ recherche soit rempli
If TextBox2.Text = " " Then
MsgBox("***** VOUS DEVEZ RENSEIGNER LE CHAMP 'RECHERCHE' *****")
Exit Sub
End If
TestPgB = 99
StepPgB = 2
P_Bar(ProgressBar1)
' Remise à blanc du champ "poids"
TextBox3.Text = ""
' Vidage avant réutilisation du Form
Try
conn.Close()
Catch ex As Exception
End Try
Try
ds.Clear()
ds.Dispose()
ds.Reset()
Catch ex As Exception
End Try
Try
da.Dispose()
Catch ex As Exception
End Try
' Dossier valide seulement de CHT00 à CHT99
Dossier = "CHT"
If Not TextBox1.Text = "0" And Not TextBox1.Text = "1" And Not TextBox1.Text = "2" _
And Not TextBox1.Text = "3" And Not TextBox1.Text = "4" And Not TextBox1.Text = "5" _
And Not TextBox1.Text = "6" And Not TextBox1.Text = "7" And Not TextBox1.Text = "8" _
And Not TextBox1.Text = "9" Then
If IsNumeric(TextBox1.Text) Then
If TextBox1.Text < 100 Then
Dossier = Dossier & TextBox1.Text
End If
End If
End If
' Critères de sélection de la requête
String_SQL()
Select Case Selindex
Case 0
strSql = strSql & "WHERE D.DWGBBSNUM LIKE '%" & TextBox2.Text & "%' AND D.RC_NUM <> 1"
Case 1
strSql = strSql & "WHERE C.CUST_CODE LIKE '%" & TextBox2.Text & "%'"
Case 2
strSql = strSql & "WHERE C.SIT_NAME LIKE '%" & TextBox2.Text & "%' AND D.RC_NUM <> 1"
End Select
' Ajout de la sélection "Dossier"
If Dossier <> "CHT" Then
strSql = strSql & " AND R.ESRC_FILE ='" & Dossier & "'"
End If
Connexion(strConn, strSql)
MiseForme()
ComboBox1.Focus()
End Sub
Private Sub String_SQL()
' Requête multi-tables
strSql = "SELECT R.ESRC_FILE, R.RC_NUM, R.PS_CODE, CU.INV_NAME, C.SIT_NAME, C.SIT_TOWN, A.CT_NAME, A.CT_TOWN, D.DWGBBSNUM, R.FABWEIGHT, R.DELIVASKED, R.CUST_REF FROM DWGBBS AS D "
strSql = strSql & "JOIN REF_PS AS R ON R.ESRC_FILE = D.ESRC_FILE AND R.RC_NUM = D.RC_NUM AND R.PS_TITLE = D.DWGBBSNUM "
strSql = strSql & "JOIN CONTRACT AS C ON C.ESRC_FILE = D.ESRC_FILE AND C.RC_NUM = D.RC_NUM "
strSql = strSql & "LEFT JOIN CONTRADR AS A ON A.ESRC_FILE = D.ESRC_FILE AND A.ES_NUM = D.ES_NUM AND A.SEQ_NUM = R.ADDR_NUM "
strSql = strSql & "JOIN CUSTOMER AS CU ON CU.CUST_CODE = C.CUST_CODE "
End Sub
Private Sub P_Bar(ByVal PgB As ProgressBar)
' Initialisation du compteur du ProgressBAr
If TestPgB = 99 Then
TestPgB = 0
PgB.Value = 0
End If
' Limite maxi du ProgressBar : 100 --> il se remplit de 0 à 100
' puis se vide de 100 à 0
If TestPgB = 0 Then
PgB.Value = PgB.Value + StepPgB
End If
If TestPgB = 1 Then
PgB.Value = PgB.Value - StepPgB
End If
If PgB.Value = 100 Then
TestPgB = 1
End If
If PgB.Value = 0 Then
TestPgB = 0
End If
RestPgB = PgB.Value
End Sub
Private Sub PictureBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox1.Click
' Déclarations pour classeur Excel
Dim Classeur As Excel.Workbook
Dim Feuille As Excel.Worksheet
Dim NomClasseur As String = "X:\PublicationVB\InterrogationListes\Résultat_Interro_Listes.xls"
Dim Pstr As String ' Affichage du poids en tonne
Appli.Visible = True ' Application visible
Appli.DisplayAlerts = False ' Inactivation des alertes
Appli.ScreenUpdating = False ' Inactivation de l'affichage
' Ouverture du classeur
Try
Appli.Workbooks.Open(NomClasseur)
Catch ex As Exception
MsgBox("***** IMPOSSIBLE D'OUVRIR LE FICHIER EXCEL *****")
End Try
' Initialisation Classeur et Feuille Excel
Classeur = CType(Appli.Workbooks(1), Excel.Workbook)
Feuille = CType(Classeur.Worksheets(1), Excel.Worksheet)
Dim ids As Short ' Compteur de lignes DataSet (row)
Dim jds As Short ' Compteur de colonnes DataSet (column)
i = 2 ' Compteur de lignes dans classeur
j = 1 ' Compteur de colonnes dans classeur
' Chargement des cellules à partir du DataSet
With ds.Tables("REF_PS")
For ids = 0 To .Rows.Count - 1
For jds = 0 To .Columns.Count - 1
Feuille.Cells(i, j) = .Rows(ids)(.Columns(jds))
j = j + 1
Next
i = i + 1
j = 1
Next
End With
Appli.ScreenUpdating = True ' Réactivation de l'affichage
Pstr = Poids & " TO"
Appli._Run2("Formattage") ' Exécution macro Excel
Feuille.Cells(i, 1) = "TOTAL"
Feuille.Cells(i, 10) = Pstr
' MACRO FORMATTAGE : recherche la prochaine cellule vide, la sélectionne
' et met la police à "gras" (aussi cellule destinée au poids)
End Sub
End Class
Conclusion :
Le code a été fait aussi pour ma propre formation, même s'il est possible de le simplifier certaines choses ont été écrites afin de me servir d'exemple.
Le chemin d'accès au classeur et au logo Excel fait référence à notre serveur, pensez à le changer.
Prochaine mise à jour : impression directe du DataGrid, délai ???
Les commentaires sont bienvenus.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.