BDD AVEC RECHERCHE

'------------------------------------------------------------------------------------------------------------------------------------------------------
Form1


Option Explicit
Public bd As New ADODB.Connection
Public cmdado As New ADODB.Command
Public tb As New ADODB.Recordset
Dim msg1 As String
Dim lar As Long, lng As Long
Public db As Database
Public rs As Recordset
Public sql As String
Private Sub Command1_Click()

        tb.AddNew
          tb![incasso] = IIf(IsNull(txtincasso.Text), "", (txtincasso.Text))
          tb![entrate] = IIf(IsNull(txtentrate.Text), "", (txtentrate.Text))
          tb![Vendite] = IIf(IsNull(txtvendite.Text), "", (txtvendite.Text))
          tb![casa] = IIf(IsNull(txtcasa.Text), "", (txtcasa.Text))
          tb![Giorno] = IIf(IsNull(txtgiorno), "", (txtgiorno))
          tb![mese] = IIf(IsNull(txtmese), "", (txtmese))
          tb![anno] = IIf(IsNull(txtanno), "", (txtanno))
adresse:
         tb.Update
        Call load_list
End Sub

Private Sub Command2_Click()
If Option1.Value = True Then
lstview1.ListItems.Clear
Dim LstItem As ListItem
    cmdado.CommandText = "select * from carnetdadresse"
    tb.Requery
    On Error Resume Next
    While (Not tb.EOF)
      If (tb.RecordCount <> 0) Then
      If (tb!mese) = mese.Text Then
          Set LstItem = lstview1.ListItems.Add(, , CStr(tb!incasso))
          If Not IsNull(tb!entrate) Then LstItem.SubItems(1) = CStr(tb!entrate)
          If Not IsNull(tb!Vendite) Then LstItem.SubItems(2) = CStr(tb!Vendite)
             If Not IsNull(tb!casa) Then LstItem.SubItems(3) = CStr(tb!casa)
           If Not IsNull(tb!Giorno) Then LstItem.SubItems(4) = CStr(tb!Giorno)
             If Not IsNull(tb!mese) Then LstItem.SubItems(5) = CStr(tb!mese)
             If Not IsNull(tb!anno) Then LstItem.SubItems(6) = CStr(tb!anno)
      Else
          End If
          End If
      tb.MoveNext
    Wend
    Else
lstview1.ListItems.Clear
    cmdado.CommandText = "select * from carnetdadresse"
    tb.Requery
    On Error Resume Next
    While (Not tb.EOF)
      If (tb.RecordCount <> 0) Then
      If (tb!anno) = anno.Text Then
          Set LstItem = lstview1.ListItems.Add(, , CStr(tb!incasso))
          If Not IsNull(tb!entrate) Then LstItem.SubItems(1) = CStr(tb!entrate)
          If Not IsNull(tb!Vendite) Then LstItem.SubItems(2) = CStr(tb!Vendite)
             If Not IsNull(tb!casa) Then LstItem.SubItems(3) = CStr(tb!casa)
           If Not IsNull(tb!Giorno) Then LstItem.SubItems(4) = CStr(tb!Giorno)
             If Not IsNull(tb!mese) Then LstItem.SubItems(5) = CStr(tb!mese)
             If Not IsNull(tb!anno) Then LstItem.SubItems(6) = CStr(tb!anno)
      Else
          End If
          End If
      tb.MoveNext
    Wend
    End If
End Sub

Private Sub Command3_Click()
Form2.Show
End Sub

Private Sub Command4_Click()
     On Error GoTo Err_Main
          If (tb.RecordCount > 0) Then
            tb.Delete
            tb.Update
            tb.Requery
            Call load_list
                Else
Err_Main:
MsgBox "errore devi selezionare un Item"
End If
End Sub

Private Sub Command5_Click()
 If Me.Height = "13710" Then
 Me.Height = "11100"
 Else
 Me.Height = "13710"
 End If
End Sub

Private Sub del_Click()
     On Error GoTo Err_Main
          If (tb.RecordCount > 0) Then
            tb.Delete
            tb.Update
            tb.Requery
            Call load_list
                Else
Err_Main:
MsgBox "errore devi selezionare un Item"
End If
End Sub

Private Sub Form_Load()
Me.Height = "11100"
mnuFile.Visible = False
Data = Date
     Dim i As Long
     ' Sélection du mode détaillé
     Me.lstview1.View = lvwReport
     ' Création des colonnes
     Me.lstview1.ColumnHeaders.Add 1, , "Incasso"
     Me.lstview1.ColumnHeaders.Add 2, , "Persone entrate"
     Me.lstview1.ColumnHeaders.Add 3, , "Vendite"
     Me.lstview1.ColumnHeaders.Add 4, , "Casa"
     Me.lstview1.ColumnHeaders.Add 5, , "Giorno"
     Me.lstview1.ColumnHeaders.Add 5, , "Mese"
     Me.lstview1.ColumnHeaders.Add 5, , "Anno"
     
     For i = 1 To 8

         Me.lstview1.ListItems.Add i, , "Valeur " & CStr(i) & ",1"
         Me.lstview1.ListItems(i).SubItems(1) = "Valeur " & CStr(i) & ",2"
         Me.lstview1.ListItems(i).SubItems(2) = "Valeur " & CStr(i) & ",3"
         Me.lstview1.ListItems(i).SubItems(3) = "Valeur " & CStr(i) & ",4"
         Me.lstview1.ListItems(i).SubItems(4) = "Valeur " & CStr(i) & ",5"
         Me.lstview1.ListItems(i).SubItems(5) = "Valeur " & CStr(i) & ",6"
         Me.lstview1.ListItems(i).SubItems(6) = "Valeur " & CStr(i) & ",7"
     Next i
     ' Sélection du mode détaillé

       '""""""""""""""""""""""
             bd.Provider = "Microsoft.jet.oledb.4.0"
        bd.ConnectionString = App.Path & "\data.mdb"
        bd.Open
        cmdado.ActiveConnection = Me.bd
        cmdado.CommandText = "select * from carnetdadresse"
        tb.CursorLocation = adUseClient
        tb.CursorType = adOpenDynamic
        tb.LockType = adLockPessimistic
        tb.Open cmdado
        lstview1.ListItems.Clear
        lstview1.ColumnHeaders.Clear
        lstview1.ColumnHeaders.Add , , "Incasso", (lstview1.Width * (2 / 22)), lvwColumnLeft
        lstview1.ColumnHeaders.Add , , "Persone entrate", (lstview1.Width * (2 / 15)), lvwColumnLeft
        lstview1.ColumnHeaders.Add , , "Vendite", (lstview1.Width * (2 / 15)), lvwColumnLeft
        lstview1.ColumnHeaders.Add , , "casa", (lstview1.Width * (2 / 30)), lvwColumnLeft
        lstview1.ColumnHeaders.Add , , "Giorno", (lstview1.Width * (3 / 20)), lvwColumnLeft
        lstview1.ColumnHeaders.Add , , "Mese", (lstview1.Width * (2 / 30)), lvwColumnLeft
        lstview1.ColumnHeaders.Add , , "Anno", (lstview1.Width * (3 / 20)), lvwColumnLeft
        
        lstview1.View = lvwReport

        cmdado.CommandText = "select * from carnetdadresse"
        tb.Requery
        Call load_list
        Me.Show
        lng = Me.Width
        lar = Me.Height
        

End Sub
Private Sub load_list()
Dim LstItem As ListItem
    lstview1.ListItems.Clear
    cmdado.CommandText = "select * from carnetdadresse"
    tb.Requery
    On Error Resume Next
    While (Not tb.EOF)
      If (tb.RecordCount <> 0) Then
          Set LstItem = lstview1.ListItems.Add(, , CStr(tb!incasso))
          If Not IsNull(tb!entrate) Then LstItem.SubItems(1) = CStr(tb!entrate)
          If Not IsNull(tb!Vendite) Then LstItem.SubItems(2) = CStr(tb!Vendite)
             If Not IsNull(tb!casa) Then LstItem.SubItems(3) = CStr(tb!casa)
           If Not IsNull(tb!Giorno) Then LstItem.SubItems(4) = CStr(tb!Giorno)
             If Not IsNull(tb!mese) Then LstItem.SubItems(5) = CStr(tb!mese)
             If Not IsNull(tb!anno) Then LstItem.SubItems(6) = CStr(tb!anno)
          End If
      tb.MoveNext
    Wend
End Sub

Private Sub lstview1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
         Dim Indexcol As Integer
            Indexcol = ColumnHeader.Index
            Select Case Indexcol
                Case Is = 1
                    tb.Sort = "entrate ASC"
                Case Is = 2
                    tb.Sort = "Vendite ASC"

                Case Is = 3
                    tb.Sort = "casa ASC"
                
                Case Is = 4
                    tb.Sort = "Giorno ASC"
                    
                Case Is = 4
                    tb.Sort = "mese ASC"
                Case Is = 4
                    tb.Sort = "anno ASC"
                End Select
            Call load_list
End Sub

Private Sub lstview1_ItemClick(ByVal Itemselect As ListItem)
       Dim IndexItem As Long
          tb.MoveFirst
          IndexItem = Itemselect.Index
          tb.Move (IndexItem - 1)
          On Error Resume Next

End Sub

Private Sub lstview1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then PopupMenu mnuFile
mnuFile.Visible = False
'Met le menu Fichier en invisible
'Met le menu Edit en invisible
End Sub

Private Sub mod_Click()

End Sub

Private Sub Option1_Click()
mese.Visible = True
anno.Visible = False
End Sub

Private Sub Option2_Click()
mese.Visible = False
anno.Visible = True
End Sub
 Public Sub ImprimerListView(lvwSource As ListView, sTitre As String, sSousTitre As String, Optional ByVal sNomPolice As String = "Arial", Optional ByVal iTaillePolice As Integer = 10)

     On Error GoTo Err_Main
     Const lNB_MAX_ELEM_PAGE As Long = 35
     Dim p As Printer
     Dim lComptElem As Long
     Dim liItem As ListItem
     Dim idxCol As Integer
     Dim lLargTot As Long
     Dim lCurXtmp As Long, lCurYtmp As Long
     Dim lNumPageCour As Long, lNbPages As Long
     Dim sApplication As String, sDate As String
     Dim lNbCarAff As Long

     sTitre = UCase(Trim(sTitre))
     sApplication = App.Title & " v" & CStr(App.Major) & "." & CStr(App.Minor) & "." & CStr(App.Revision)
     sDate = Format(Now, "dd/mm/yyyy")
     ' Calcul de la largeur totale des colonnes du listview
     lLargTot = 0
     For idxCol = 1 To lvwSource.ColumnHeaders.Count
         lLargTot = lLargTot + lvwSource.ColumnHeaders(idxCol).Width
     Next
     ' Détermination du nombre de pages, initialisation du numéro de la première page
     lNbPages = Int(lvwSource.ListItems.Count / lNB_MAX_ELEM_PAGE) + 1
    lNumPageCour = 1

     ' Instancie l'imprimante cible (imprimante par défaut)
     Set p = Printer

     ' Initialisation de la page
     p.Orientation = vbPRORLandscape
     p.Font = sNomPolice: p.FontSize = iTaillePolice
     p.ScaleHeight = 100: p.ScaleWidth = 100

     ' Positionne le titre et le sous-titre de la page
     p.FontBold = True: p.CurrentX = 50 - (p.TextWidth(sTitre) / 2): p.CurrentY = 3: p.Print sTitre
     p.FontBold = False: p.CurrentX = 90: p.CurrentY = 3: p.Print "Page " & CStr(lNumPageCour) & "/" & CStr(lNbPages)
     p.FontBold = False: p.CurrentX = 50 - (p.TextWidth(sSousTitre)) / 2: p.CurrentY = 5: p.Print sSousTitre

     ' Positionne les en-têtes de colonnes
     p.CurrentX = 0
     For idxCol = 1 To lvwSource.ColumnHeaders.Count
         lCurXtmp = p.CurrentX
         p.CurrentY = 10
If lvwSource.ColumnHeaders(idxCol).Width > 0 Then
             p.FontBold = True: p.Print lvwSource.ColumnHeaders(idxCol).Text
End If
         p.CurrentX = lCurXtmp + (lvwSource.ColumnHeaders(idxCol).Width * 100) / lLargTot
     Next
     p.Line (0, 13)-(100, 13)

     ' Ajout des éléments
     p.CurrentY = 14
     lComptElem = 0
     For Each liItem In lvwSource.ListItems
         lCurYtmp = p.CurrentY
         For idxCol = 1 To lvwSource.ColumnHeaders.Count
If lvwSource.ColumnHeaders(idxCol).Width > 0 Then
                 ' Détermine le nombre de caractères affichables
                 p.FontBold = False
                 lNbCarAff = Int(((lvwSource.ColumnHeaders(idxCol).Width * 100) / lLargTot) / p.TextWidth("A"))
If idxCol = 1 Then
                     lCurXtmp = 0
                     p.CurrentX = lCurXtmp
                     p.CurrentY = lCurYtmp
                     p.FontBold = False: p.Print Left(liItem.Text, lNbCarAff)
Else
                     lCurXtmp = lCurXtmp + (lvwSource.ColumnHeaders(idxCol - 1).Width * 100) / lLargTot
                     p.CurrentX = lCurXtmp
                     p.CurrentY = lCurYtmp
                     p.FontBold = False: p.Print Left(liItem.SubItems(idxCol - 1), lNbCarAff)
End If
Else
                 lCurXtmp = lCurXtmp + (lvwSource.ColumnHeaders(idxCol - 1).Width * 100) / lLargTot
End If
         Next

         ' Incrémente le nombre d'éléments imprimés
         lComptElem = lComptElem + 1

If lComptElem = lNB_MAX_ELEM_PAGE Then
             lComptElem = 0 ' Réinitialise le nomde d'élément ecrits
             p.Line (0, 90)-(100, 90) ' Trace la ligne de fin de liste
             p.CurrentX = 5: p.CurrentY = 93: p.FontBold = True: p.Print sApplication
             p.CurrentX = 85: p.CurrentY = 93: p.FontBold = False: p.Print sDate
             p.NewPage ' Change de page
             lNumPageCour = lNumPageCour + 1
             ' Positionne le titre et le sous-titre de la page
             p.FontBold = True: p.CurrentX = 50 - (p.TextWidth(sTitre) / 2): p.CurrentY = 3: p.Print sTitre
             p.FontBold = False: p.CurrentX = 90: p.CurrentY = 3: p.Print "Page " & CStr(lNumPageCour) & "/" & CStr(lNbPages)
             p.FontBold = False: p.CurrentX = 50 - (p.TextWidth(sSousTitre)) / 2: p.CurrentY = 5: p.Print sSousTitre
             ' Positionne les en-têtes de colonnes
             p.CurrentX = 0
             For idxCol = 1 To lvwSource.ColumnHeaders.Count
                 lCurXtmp = p.CurrentX
                 p.CurrentY = 10
If lvwSource.ColumnHeaders(idxCol).Width > 0 Then
                     p.FontBold = True
                     p.Print lvwSource.ColumnHeaders(idxCol).Text
                     p.FontBold = False
End If
                 p.CurrentX = lCurXtmp + (lvwSource.ColumnHeaders(idxCol).Width * 100) / lLargTot
             Next
             p.Line (0, 13)-(100, 13)
             p.CurrentY = 14
End If
     Next liItem

     ' Ajoute le pied de page de la dernière page
     p.Line (0, 90)-(100, 90) ' Trace la ligne de fin de liste
     p.CurrentX = 5: p.CurrentY = 93: p.FontBold = True: p.Print sApplication
     p.CurrentX = 85: p.CurrentY = 93: p.FontBold = False: p.Print sDate

     p.EndDoc ' Lance l'impression du document créé

Fin:
     On Error Resume Next
     Set p = Nothing
     Exit Sub

Err_Main:
     If Not (p Is Nothing) Then p.KillDoc 'Annule l'impressino du document
     MsgBox Err.Description, vbCritical, App.Title
     Resume Fin
 End Sub

Private Sub print_Click()
Form2.Show
End Sub
'------------------------------------------------------------------------------------------------------------------------------------------------------
Form 2
Private Sub Command1_Click()
Call Form1.ImprimerListView(Form1.lstview1, Text1, Text2)
End Sub

Private Sub Form_Load()

End Sub

Télécharger le zip

25 janvier 2007 17:08:34 :

TITRE