Comment faire pour que le nb de ligne d'un msflexgrid s'adapte au nombre de res

Question

Bonjour,
Je me suis fait un petit prog en Vb6 qui recherche des donnees ddans une base access. Tout fonctionnait bien jusqu'à ce que j'ajoutte la possibilité d'imprimer les resultats. Pour que mon prog tourne, je dois absolument configurer le Msflexgrid avec plus de ligne que la recherche n'en demande d'ou gaspillage d'encre t de papier. Si je ne  configure pas assez de ligne pour le msflexgrid, le prog plante....
Pourtant, il me semble avoir cette ligne qui dit que le nombre de  resultat  est pris comme reference pour le nombre de ligne. MAis ca ne marche pas. Il y a surement une erreur. MAis je ne la trouve pas.

Voici le code ci dessous.

D'avance, Merci




dan


Option Explicit


' Déclarations :
Private Const SW_SHOWNORMAL = 1

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
    "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

'----------------------------------------------------------------------------------------------


Private Sub Centercells()

     Dim column As Integer
     For column = 0 To 9
      
     grdFilm.ColAlignment(column) = flexAlignCenterCenter
     Next column
     grdFilm.ColAlignment(2) = flexAlignLeftCenter
     End Sub
      
     Private Sub SizeCells()
           
     
     Dim column As Integer
          For column = 0 To 1
          grdFilm.ColWidth(column) = 700
          Next column
                    
          grdFilm.ColWidth(2) = 500
          grdFilm.ColWidth(3) = 6850
          grdFilm.ColWidth(4) = 600
          grdFilm.ColWidth(5) = 2500
          grdFilm.ColWidth(6) = 2000
          grdFilm.ColWidth(7) = 2500
          grdFilm.ColWidth(8) = 1500
          grdFilm.ColWidth(9) = 1200
          
          
          
          
          
          
          
          
     End Sub
     
    ' Private Sub Titles()

     'grdFilm.Row = 0
     'grdFilm.Col = 0
     'grdFilm.Text = "BOX"
      
     'grdFilm.Col = 1
     'grdFilm.Text = "DISQUE"
 
     'grdFilm.Col = 2
     'grdFilm.Text = "TITRE DU FILM"
 
     'grdFilm.Col = 3
     'grdFilm.Text = "ANNEE "
 
     'grdFilm.Col = 4
     'grdFilm.Text = "ACTEUR PRINCIPAL"
 
     'grdFilm.Col = 5
     'grdFilm.Text = "REMARQUE"
 
     'grdFilm.Col = 6
     'grdFilm.Text = "ACTEUR SECONDAIRE"
 
     'grdFilm.Col = 7
     'grdFilm.Text = "GENRE "
 
     'grdFilm.Col = 8
     'grdFilm.Text = "QUALITE"
 
 
     'grdFilm.Col = 9
     'grdFilm.Text = "SUPPORT"
 
     'End Sub

 
 '=============================================
'#### Au lieu d'écrire tout ce code, on utilise une boucle qui fait _
  bien l'affaire. Il suffit de changer "Titles0" en "Titles" et inversement
'####
'==============================================

 Private Sub Titles0()

 
   Dim cnt%
   grdFilm.Row = 0
   For cnt = 0 To frmGestion.AdoGestion.Recordset.Fields.Count - 1
   grdFilm.Col = cnt
   grdFilm.Text = frmGestion.AdoGestion.Recordset.Fields(cnt).Name
     Next cnt
 End Sub

     
    
'----------------------------------------------------------------------------------------------

Private Sub Command1_Click()
frmRecherche.Hide
frmGestion.AdoGestion.Recordset.MoveFirst 'Je replace le curseur sur la 1ere position de la base de données
frmGestion.Show
End Sub

Private Sub Command2_Click()
'Rafraichissement du textbox pour une nouvelle recherche
Textbox1.Text = ""
grdFilm.Clear
frmGestion.AdoGestion.Recordset.MoveFirst
'Je replace le curseur sur la 1ere position de la base de données
Call Titles0
End Sub

Private Sub Command3_Click()
Call Rechercheexacte
End Sub

Private Sub Command4_Click()
Call Recherchepartielle

End Sub

 

Private Sub Command5_Click()
frmimp.Show 1

End Sub

Private Sub Form_Load()
   'Si à un moment donné, on veut ajouter d'autres champs, les boutons d'option seront crées dynamiquement _
   (par le code), par exemple en utilisant un groupe de contrôles : _
   on definit une variable compteur : Dim Cont As Integer _
   Bien sûr, on doit placer un seul bouton d'option sur la feuille auquel on donne l'index 0(zéro) _
   puis on crée les autres et on les positionne :
    Call Centercells
    Call SizeCells
    Call Titles0
    

    Dim Cont As Integer
   
    For Cont = 1 To frmGestion.AdoGestion.Recordset.Fields.Count - 1
      Load OptionCritere(Cont)
      OptionCritere(Cont).Move OptionCritere(Cont - 1).Left, OptionCritere(Cont - 1).Top + OptionCritere(Cont - 1).Height + 5
      OptionCritere(Cont).Visible = True
      OptionCritere(Cont).Caption = frmGestion.AdoGestion.Recordset.Fields(Cont).Name
    Next Cont
    OptionCritere(2).Value = True

 
  End Sub




Private Sub Recherchepartielle()

  
   Dim cText As String
   cText = Textbox1.Text
  
  Dim cCritere As String
 
   
    Dim Indx%
     For Indx = 0 To OptionCritere.Count - 1
      If OptionCritere(Indx).Value Then cCritere = OptionCritere(Indx).Caption
     Next Indx

  
   '**** Dans cecas, il faut déclarer : cText As Variant et non pas As String _
     car le type Variant comprend, entre autres, les chaînes et les nombres *****
   With frmGestion.AdoGestion.Recordset
   .MovePrevious
   .MoveFirst
     
     '---TRES  IMPORTANT !
     '---ETANT DONNE QUE DANS LA CASSE EST TRES IMPORTANTE? ON VA METTRE
     '---LE CONTENU EN MAJUSCULE
     
     cText = UCase(cText)
     
     
    '---ET POUR UNE RECHERCHE PARTIELLE ON A BESOIN DE LA LONGUEUR DUTEXTE ENTRE.
       Dim xLenText As Integer
       xLenText = Len(cText)
     
       Dim trouv As Boolean
       Dim iTrv As Integer   ' pour le nombre d'éléménts trouvés
       Dim xcont As Integer  ' pour le nombre de champs
       iTrv = 0
       
       
       Do While Not .EOF
                         
          If UCase(Mid(.Fields(cCritere), 1, xLenText)) = cText _
          Or InStr(1, UCase(.Fields(cCritere)), cText) Then
           iTrv = iTrv + 1
           trouv = True
           frmRecherche.grdFilm.Row = iTrv
           
       '============================================
    ' Nouveau code ajouté ainsi que pour la recherche étendue
            If iTrv >= 1 Then
               grdFilm.Row = iTrv
               For xcont = 0 To .Fields.Count - 1
                grdFilm.Col = xcont
        ' Si .Fields(xcont) retourne une chaîne vide, une erreur se produit _
         j'ai dû alors remplacer la chaîne vide par "?"
                grdFilm.Text = IIf(.Fields(xcont)  "", .Fields(xcont), "Sans objet")
               Next xcont
             End If
'============================================
             
             
             '  Exit Do    'pour arrêter quand je trouve si on ne veut q'un résultat
             
             ' **** Pour avoir tous les résultats, on doit les affecter à un ListBox de cette maniere =>
             '===> List1.AddItem .Fields(cCritere)
             ' Mieux encore, on peut affecter à la ListBox, tous les champs d'un enregistrement _
             comme suit :
             Dim Ind%, strRet$
             strRet = ""
             For Ind = 0 To .Fields.Count - 1
              strRet = strRet & .Fields(Ind) & "        "
             Next Ind
        
            
         End If
         
        .MoveNext
      Loop
   End With
   If trouv = False Then
   ' Cette ligne servait juste a afficher le msgbox Trouvé inutile. je le laisse au cas ou....
   'If trouv Then
   ' MsgBox "trouvé !"
   ' Else
     MsgBox "aucun enregistrement trouvé !"
     frmGestion.AdoGestion.Recordset.MoveFirst
   End If
 
  
    
     
 

End Sub

Private Sub Option1_Click(Index As Integer)
Call Recherchepartielle

End Sub
Private Sub Rechercheexacte()
  
  'lancement de la recherche
    
   Dim cText As String
   cText = Textbox1.Text
  
  Dim cCritere As String
  
   
  ' ***** Dans cette partie, on pourra définir autant de critères qu'il de champs _
   en utilisant des OptionButtons de même nombre que les enregistrements. Si à un moment _
   donné, on veut ajouter d'autres champs, les boutons d'option seront crées dynamiquement _
   (par le code), par exemple en utilisant un groupe de contrôles : _
   on definit une variable compteur : Dim Cont As Integer _
   Bien sûr, on doit placer un seul bouton d'option sur la feuille auquel on donne l'index 0(zéro) _
   puis on crée les autres et on les positionne :
   ' -- Dim Cont As Integer
   ' -- For Cont = 1 To frmGestion.AdoGestion.Recordset.Fields.Count - 1
   ' --  Load OptionCritere(Cont)
   ' --  OptionCritere(Cont).Move OptionCritere(Cont - 1).Left, OptionCritere(Cont - 1).Top + OptionCritere(Cont - 1).Height + 5
   ' --  OptionCritere(Cont).Visible = True
   ' --  OptionCritere(Cont).Caption = frmGestion.AdoGestion.Recordset.Fields(Cont)
   ' -- Next Cont
    '# Le code précédent doit être placer dans l'évènement Form_Load _
    et la structure conditionnelle suivante doit être modifiéeen conséquence, _
    par exemple :
    Dim Indx%
     For Indx = 0 To OptionCritere.Count - 1
      If OptionCritere(Indx).Value Then cCritere = OptionCritere(Indx).Caption
     Next Indx
 
   
  'remarques : cCritere peut être un Integer , et dans ce cas
  'avoir le numéro ordinal du champ au lieu de son nom.
  '(par exemple :  0 pour le titre , 1 pour Disc, 2 pour Box...)
  
   '**** Dans cecas, il faut déclarer : cText As Variant et non pas As String _
     car le type Variant comprend, entre autres, les chaînes et les nombres *****
   With frmGestion.AdoGestion.Recordset
   .MovePrevious
   .MoveFirst
     
     '---TRES  IMPORTANT !
     '---ETANT DONNE QUE DANS LA CASSE EST TRES IMPORTANTE? ON VA METTRE
     '---LE CONTENU EN MAJUSCULE
     
     cText = UCase(cText)
     
    '---ET POUR UNE RECHERCHE PARTIELLE JBESOIN DE LA LONGUEUR DUTEXTE ENTRE.
       Dim xLenText As Integer
       xLenText = Len(cText)
     
       Dim trouv As Boolean
       Dim iTrv As Integer   ' pour le nombre d'éléménts trouvés
       Dim xcont As Integer  ' pour le nombre de champs
       
       iTrv = 0
       
     
     Do While Not .EOF
       
       '--pour une recherche exact
       If UCase(.Fields(cCritere)) = cText Then
            '--pour une recherche partielle
           '--- recherchre le premier qui commence par le text entré
         ' If UCase(Mid(.Fields(cCritere), 1, xLenText)) = cText Then
            '--actives donc l' un ou l' autre
            iTrv = iTrv + 1
             trouv = True
                   
              '============================================
    ' Nouveau code ajouté ainsi que pour la recherche étendue
            If iTrv >= 1 Then
               grdFilm.Row = iTrv
               For xcont = 0 To .Fields.Count - 1
                grdFilm.Col = xcont
        ' Si .Fields(xcont) retourne une chaîne vide, une erreur se produit _
         j'ai dû alors remplacer la chaîne vide par "?"
               grdFilm.Text = IIf(.Fields(xcont)  "", .Fields(xcont), "?")
               Next xcont
             End If
             
            
          ' Exit Do    'pour arrêter quand je trouve
         
          ' **** Pour avoir tous les résultats dans un  ListBox =>
           '===> List1.AddItem .Fields(cCritere)
           
             Dim Ind%, strRet$
             strRet = ""
             For Ind = 0 To .Fields.Count - 1
              strRet = strRet & .Fields(Ind) & " - "
             Next Ind
             
             
         End If
         
        .MoveNext
      Loop
   End With
 
  If trouv = False Then
   
     MsgBox "Aucun enregistrement trouvé !"
     frmGestion.AdoGestion.Recordset.MoveFirst
     
   End If
End Sub

Private Sub Option2_Click(Index As Integer)
Call Rechercheexacte
End Sub


      
    
   ' Private Sub ChkResizing_Click()
   'grdFilm.AllowUserResizing = 3 * ChkResizing.Value
    ' Les valeurs pour AllowUserResizing sont
    ' 0 : flexResizeNone
    ' 1 : flexResizeColumns
    ' 2 : flexResizeRows
    ' 3 : flexResizeBoth ==> c'est pour cela que j'ai mis: "3 * ChkResizing.Value"
    ' Si par hazard vous souaitez activer l'une ou l'autre fonctionnalité _
    il suffit de remplacer le CheckBox par 4 OptionButtons indexées de 0 à 3 _
     nommées OptionResizing par exemple et dans le code on mettra :
  '===    Dim I%
  'For I 0 To 3
  'If OptionResizing(I).Value Then grdFilm.AllowUserResizing I
  '===    Next I
'End Sub
     
     
     
Private Sub Label1_Click()

End Sub

Private Sub Picture1_Click()
ShellExecute Me.hwnd, "open", "http://www.cinefil.com/", vbNullString, vbNullString, SW_SHOWNORMAL
End Sub

Private Sub Picture8_Click()
ShellExecute Me.hwnd, "open", "http://www.imdb.com/", vbNullString, vbNullString, SW_SHOWNORMAL
End Sub

Private Sub Picture9_Click()
ShellExecute Me.hwnd, "open", "http://www.allocine.fr/", vbNullString, vbNullString, SW_SHOWNORMAL
End Sub

ucfoutu · Answer

Bonjour,

Beaucoup de code ...
Mais la vraie question est : comment imprimes-tu donc les "résultats" ? (par quelle méthode et quel code ?). Je vois enh effet mal la nécessité de redimensionner la Flexgrid pour imprimer son contenu ...


____________________
Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !
Cliquer sur "Réponse acceptée" (en bas d'une solution avérée adéquate) rendra service à d'autres. PENSEZ-Y.

Comment faire pour que le nb de ligne d'un msflexgrid s'adapte au nombre de res

1 réponse

Votre réponse

Discussions similaires