FAQ Visual Basic Consultez toutes les FAQ

Nombre d'auteurs : 50, nombre de questions : 300, dernière mise à jour : 9 février 2020 

 
OuvrirSommaireInterfaceContrôles

La datagrid est réservée à l'utilisation d'une grille liée à une source de données. Vous pouvez modifier le format d'affichage de chaque colonne. L'utilisateur peut saisir les valeurs au clavier, ajouter et supprimer des lignes. Toutes ces modifications sont prises en compte dans la base de données, avec très peu voire aucune programmation. Cependant, les choses se compliquent très vite dès que vous voulez modifier des données portant sur plusieurs tables de la base.

Quant à la MSFlexgrid, son inconvénient majeur est la non prise en charge de saisie de données. Il reste cependant plusieurs façons de combler ce manque avec quelques lignes de code. Elle peut être liée à une source de données comme la datagrid, mais le format d'affichage n'est pas modifiable. Vous pouvez aussi remplir la grille par programmation, ligne par ligne, ce qui vous permet d'afficher exactement ce que vous voulez; par contre cela peut être moins rapide à l'exécution sur un très grand nombre de lignes. A cela, il faut ajouter les possibilités de modifier la police, la couleur du texte, la couleur de fond d'une cellule, d'afficher une image dans une cellule, et de fusionner plusieurs cellules adjacentes qui contiennent la même valeur. La MSFlexgrid est donc à mon avis préférable dans la plupart des cas.

Créé le 29 juillet 2002  par Romain Puyfoulhoux

Ce programme ajoute dans la cellule courante les caractères au fur et à mesure qu'ils sont tapés. Une autre manière de faire consiste à placer un textbox qui recouvre la cellule courante, et de transférer le texte du textbox dans la cellule chaque fois que l'on quitte le textbox (évènement lostfocus).

vb
Sélectionnez
Dim strTexte
 
strTexte = MSFlexGrid1.Text
If KeyAscii = 8 Then 
    'Touche d'effacement
    If Len(strTexte) > 0 Then MSFlexGrid1.Text = Left(strTexte, Len(strTexte) - 1) 
ElseIf KeyAscii <> 13 Then
    MSFlexGrid1.Text = strTexte & Chr(KeyAscii)
End If
Créé le 29 juillet 2002  par Romain Puyfoulhoux

La méthode la plus simple consiste à utiliser des images représentant chacune un des états possibles de la case à cocher.
Ici nous aurons deux images: une pour représenter une case non cochée et une autre pour la case cochée. Ces images sont stockées dans deux simples contrôles images.
Dans toutes les cellules qui doivent contenir une case à cocher, nous insérons l'image correspondant à l'état courant de la case à cocher.

Les deux procédures du code source ci-dessous montrent comment afficher la case à cocher. La procédure InitCelluleAvecCase() initialise une cellule pour qu'elle puisse contenir une case à cocher. Elle appelle la procédure AfficheCelluleAvecCase() qui elle se contente d'afficher la bonne image.

vb
Sélectionnez
Private Sub InitCelluleAvecCase(ligne As Long, colonne As Long, Optional valeur As Boolean = False)
 
MSFlexGrid1.Col = colonne
MSFlexGrid1.Row = ligne
MSFlexGrid1.CellPictureAlignment = flexAlignCenterCenter
AfficheCelluleAvecCase ligne, colonne, valeur
 
End Sub
 
Private Sub AfficheCelluleAvecCase(ligne As Long, colonne As Long, Optional valeur As Boolean = False)
 
Set MSFlexGrid1.CellPicture = IIf(valeur, imgCaseCochee.Picture, imgCase.Picture)
 
End Sub

Voici un exemple complet qui utilise nos deux procédures. Au chargement de la form, la msflexgrid est initialisée pour afficher un tableau de commandes. Dans la troisième colonne de la grille, une case à cocher indique si la commande a été envoyée.

vb
Sélectionnez
Private Type commande
    reference As String
    montant As Single
    envoyee As Boolean
End Type
 
Dim commandes(0 To 2) As commande
 
Private Sub Form_Load()
 
Dim i As Long
 
'tableau de commandes
commandes(0).reference = "cmd0001": commandes(0).montant = 80: commandes(0).envoyee = True
commandes(1).reference = "cmd0002": commandes(1).montant = 150.2: commandes(1).envoyee = False
commandes(2).reference = "cmd0003": commandes(2).montant = 95.5: commandes(2).envoyee = True
 
'initialisation de la msflexgrid
MSFlexGrid1.Cols = 3
MSFlexGrid1.Rows = 4
MSFlexGrid1.FixedCols = 0
For i = 0 To 2
    MSFlexGrid1.TextMatrix(i + 1, 0) = commandes(i).reference
    MSFlexGrid1.TextMatrix(i + 1, 1) = commandes(i).montant
    InitCelluleAvecCase i + 1, 2, commandes(i).envoyee
Next
 
End Sub
 
Private Sub MSFlexGrid1_Click()
 
If MSFlexGrid1.Col = 2 And MSFlexGrid1.MouseRow > 0 Then
    commandes(MSFlexGrid1.Row - 1).envoyee = Not commandes(MSFlexGrid1.Row - 1).envoyee
    AfficheCelluleAvecCase MSFlexGrid1.Row, 2, commandes(MSFlexGrid1.Row - 1).envoyee
End If
 
End Sub

Méthode testée sous Win XP :

vb
Sélectionnez
Private Const Checked As Byte = 253 
Private Const UnChecked As Byte = 168 
Private Sub Form_Load() 
 
    Dim CCol, CRow As Integer 
 
    With MSFlexGrid1 
 
        .FixedCols = 0 
        .FixedRows = 1 
        .Cols = 8 
        .Rows = 8 
        .ColAlignment(2) = flexAlignCenterCenter 
 
        For CRow = .FixedRows To .Rows - 1 
 
            For CCol = 0 To .Cols - 1 
                .TextMatrix(CRow, CCol) = "Cel " & CRow & ", " & CCol 
            Next CCol 
 
            .Col = 2 
            .Row = CRow 
            .CellFontName = "Wingdings" 
            .CellFontSize = 12 
            .CellFontBold = False 
            .Text = Chr(UnChecked) 
 
        Next CRow 
 
    End With 
 
 
End Sub 
 
Private Sub MSFlexGrid1_Click() 
 
    With MSFlexGrid1 
 
        If .Col = 2 Then 
            If .Text = Chr(UnChecked) Then 
                .Text = Chr(Checked) 
            ElseIf .Text = Chr(Checked) Then 
                .Text = Chr(UnChecked) 
            End If 
        End If 
 
    End With 
 
End Sub
Mis à jour le 13 juin 2005  par Romain Puyfoulhoux, Da40, ridan

Il n'existe pas de propriété pour le faire mais voici une astuce possible :

vb
Sélectionnez
Private Sub MSFlexGrid1_SelChange()
MSFlexGrid1.RowSel = MSFlexGrid1.Row
End Sub

Si vous essayez de sélectionner plusieurs lignes à la souris, vous verrez un clignotement que vous pouvez éviter en empêchant le rafraîchissement automatique de la grille tant que le bouton de la souris est enfoncé :

vb
Sélectionnez
Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
MSFlexGrid1.Redraw = False
End Sub
 
Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
MSFlexGrid1.Redraw = True
End Sub
Créé le 17 février 2004  par Romain Puyfoulhoux

Cette fonction exporte le contenu de la msflexgrid passée en paramètre dans le fichier strFileName. Les colonnes sont séparées par le caractère passé dans le troisième paramètre.

vb
Sélectionnez
Public Function ExportGridToFile(Mygrid As MSFlexGrid, Byval strFileName as string, _
                                         Optional ByVal strSep As String = vbTab) As Boolean
 
Dim intFreeFile As Integer               'Numéro du fichier
Dim intCol As Integer, intRow As Integer 'Indices de ligne et colonne de W
Dim ligne As String                      'La ligne à écrire dans le fichier
 
On Error GoTo ExportGridToFile_ERR
 
'Prend le prochain numéro de fichier
intFreeFile = FreeFile
 
'Ouvre le fichier en bloquant son accès aux autres applications
Open strFileName For Output Access Write Lock Read Write As #intFreeFile
 
With Mygrid
    'Pour chaque ligne
    For intRow = .FixedRows To .Rows - 1
        ligne = ""
        'Pour chaque colonne
        For intCol = .FixedCols To .Cols - 1
            'Ajoute la valeur de la cellule
            ligne = ligne & .TextMatrix(intRow, intCol) & strSep
        Next intCol
        'Enlève le séparateur final
        If strSep <> "" Then ligne = Left(ligne, Len(ligne) - 1)
        Print #intFreeFile, ligne
    Next intRow
End With
 
'Valide le bon fonctionnement de la fonction
ExportGridToFile = True
 
ExportGridToFile_FIN:
    Close #intFreeFile + 1
    Exit Function
 
ExportGridToFile_ERR:
    ExportGridToFile = False
    Resume ExportGridToFile_FIN
 
End Function
Créé le 17 février 2004  par Sygale, Romain Puyfoulhoux

Copiez ce code dans un module standard :

vb
Sélectionnez
Private Type Size
        cx As Long
        cy As Long
End Type
 
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" _
                                              (ByVal hdc As Long, ByVal lpsz As String, _
                                              ByVal cbString As Long, lpSize As Size) As Long
 
Public Sub ResizeColumns(hdc As Long, flexgrid As MSFlexGrid)
 
    Dim idxRow As Long, idxCol As Long, lngMax As Long
    Dim texte As String, taille As Size
 
    With flexgrid
        'Parcoure les colonnes
        For idxCol = 0 To .Cols - 1
            lngMax = 0
            'Parcoure les lignes
            For idxRow = 0 To .Rows - 1
                texte = .TextMatrix(idxRow, idxCol)
                'met la taille du texte de la cellule en pixels dans taille
                GetTextExtentPoint32 hdc, texte, Len(texte), taille
                'lngMax est la longueur du texte le plus long dans cette colonne
                If taille.cx > lngMax Then lngMax = taille.cx
            Next
            'met lngMax en twips en ajoutant 10 pixels pour les marges
            If lngMax > 0 Then lngMax = (lngMax + 10) * Screen.TwipsPerPixelX
            'Applique la largeur de colonne si besoin
            If lngMax > .ColWidth(idxCol) Then .ColWidth(idxCol) = lngMax
        Next
    End With
 
End Sub

Voici comment appeler la procédure ResizeColumns :

vb
Sélectionnez
 ResizeColumns Me.hdc, MSFlexGrid1

La procédure attend un contexte de périphérique en premier paramètre. Le contexte de périphérique est renvoyé par la propriété hdc. Si la form et la MSFlexGrid ont la même police, vous pouvez passer le contexte de périphérique de la form. Sinon vous pouvez ajouter un PictureBox invisible qui aura la même police que celle de la MSFlexgrid et passer sa propriété hdc en premier paramètre.

Créé le 6 septembre 2004  par Romain Puyfoulhoux
vb
Sélectionnez
Picture1.PaintPicture Image1.Picture, 0, 0, Picture1.Width, Picture1.Height
Créé le 29 juillet 2002  par Romain Puyfoulhoux

Une solution consiste à utiliser l'évènement KeyPress, qui a lieu lorsqu'une touche correspondant à un caractère est enfoncée. Les touches comme shift, alt, control et F1 à F12 ne sont pas concernées. La procédure de cet évènement a un argument, KeyAscii, qui est le code du caractère à afficher. Modifiez sa valeur pour afficher le caractère que vous voulez. Donnez-lui une valeur nulle si aucun caractère ne doit être affiché. La fonction chr() renvoie le caractère dont le code est passé en paramètre.

L'exemple suivant interdit tout caractère autre que les chiffres et la touche d'effacement :

vb
Sélectionnez
Private Sub Text1_KeyPress(KeyAscii As Integer)
 
If KeyAscii <> 8 Then
    If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End If
End Sub

Une astuce souvent utilisée consiste à rechercher le caractère entré, dans une chaîne contenant tous les caractères autorisés. Si ce caractère n'est pas dans la chaîne, rien n'est affiché :

vb
Sélectionnez
Private Sub Text1_KeyPress(KeyAscii As Integer)
 
Dim allowedKeys As String
allowedKeys = "0123456789-,." & Chr(8)
If InStr(allowedKeys, Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
Créé le 6 janvier 2003  par Romain Puyfoulhoux

Une solution possible est de simuler l'appui sur les touches ctrl + z :

vb
Sélectionnez
Text1.SetFocus
SendKeys "^z"

Mais vous pouvez aussi envoyer le message EM_UNDO au textbox, grâce à la fonction SendMessage() de l'Api Windows. Ajoutez tout d'abord ces déclarations :

vb
Sélectionnez
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Const EM_UNDO = &HC7

Pour annuler la dernière modification sur le contenu de Text1 :

vb
Sélectionnez
 SendMessage Text1.hwnd, EM_UNDO, 0, 0
Créé le 6 janvier 2003  par Romain Puyfoulhoux

Une première idée serait d'utiliser la fonction Split() avec vbCrLf comme séparateur. Mais une fin de ligne n'est pas forcément due à un retour chariot. Nous allons plutôt faire appel aux API Windows.

Copiez tout d'abord ces déclarations au début du module de la form :

vb
Sélectionnez
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                    (ByVal hwnd As Long, ByVal wMsg As Long, _
                                     ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, _
                                                                     ByVal Length As Long)
 
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEINDEX = &HBB
Private Const EM_GETLINE = &HC4

La procédure ci-dessous affiche une par une les lignes du textbox dont le handle est passé en paramètre :

vb
Sélectionnez
Private Sub AfficheLignes(lngHandleTextBox As Long)
 
Dim lngNbLignes As Long, i As Long
Dim lngIndexCar As Long, intLongueurLigne As Integer
Dim strLigne As String
 
'nombre de lignes
lngNbLignes = SendMessage(lngHandleTextBox, EM_GETLINECOUNT, 0, 0)
 
For i = 1 To lngNbLignes
   'index du premier caractère de la ligne
   lngIndexCar = SendMessage(lngHandleTextBox, EM_LINEINDEX, i - 1, 0)
   'longueur de la ligne
   intLongueurLigne = SendMessage(lngHandleTextBox, EM_LINELENGTH, lngIndexCar, 0)
   'récupère la ligne dans la chaîne strLigne
   strLigne = Space(intLongueurLigne)
   CopyMemory ByVal strLigne, intLongueurLigne, Len(intLongueurLigne)
   SendMessage lngHandleTextBox, EM_GETLINE, i - 1, ByVal strLigne
   MsgBox strLigne
Next
 
End Sub
Créé le 17 février 2004  par Romain Puyfoulhoux

Créez un menu dans la form et rendez-le invisible. Puis créez des sous-menus visibles. Ce sont ces derniers qui apparaîtront dans le menu popup.

Tout se passe dans la procédure MouseDown. Afin d'empêcher le menu contextuel de Windows de s'afficher lorsque l'utilisateur va relâcher la souris, nous désactivons le textbox puis le réactivons immédiatement.

vb
Sélectionnez
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    If Button = vbRightButton Then
        Text1.Enabled = False
        Text1.Enabled = True
        PopupMenu menuTextBox 'menuTextBox est le nom du menu invisible
    End If
 
End Sub
Créé le 6 septembre 2004  par Romain Puyfoulhoux

Le contrôle TabStrip représente un ensemble d'onglets. Mais il ne permet pas d'associer des contrôles (textbox, commandbutton, etc...) à chacun des onglets. Vous devez donc gérer vous même l'affichage des contrôles en fonction de l'onglet qui est actif. Le plus simple est d'utiliser des frames indexées, et de mettre au premier plan la frame correspondant à l'onglet activé. Ici la première frame est d'index 1 :

vb
Sélectionnez
Private Sub TabStrip1_Click() 
 
frameOnglet(TabStrip1.SelectedItem.Index).ZOrder 0 
 
End Sub

Toutefois, on utilise plus souvent le contrôle Tabstrip lorsque plusieurs onglets utilisent une même frame. Dans ce cas on met dans la propriété tag de chaque objet Tab l'index de la frame qu'il doit mettre au premier plan. Le code devient alors :

vb
Sélectionnez
Private Sub TabStrip1_Click() 
 
frameOnglet(TabStrip1.SelectedItem.Tag).ZOrder 0 
 
End Sub

Il n'est pas la peine d'aligner ni de dimensionner les Frames de votre TabStrip. En général on utilise un code d'alignement dans l'événement Load de la feuille semblable à celui-ci :

vb
Sélectionnez
For compteur = 0 To frameOnglet.Count-1
    With TabStrip1 
        frameOnglet(compteur).Move .ClientLeft, .ClientTop, .ClientWidth, .ClientHeight 
    End With 
Next compteur
Mis à jour le 4 septembre 2003  par Romain Puyfoulhoux, Jean-Marc Rabilloud

Pour cela, DAO 3.6 et Jet 4.0 doivent être installés. Dans les références de votre projet, enlevez "Microsoft DAO 3.5 Object Library" et sélectionnez "Microsoft DAO 3.6 Object Library". Puis utilisez ce code source pour vous connecter :

vb
Sélectionnez
Dim daoDB36 As Database
Dim rs As Recordset
Dim sPath As String
 
sPath = "c:\base.mdb"
Set daoDB36 = DBEngine.OpenDatabase(sPath)
Set rs = daoDB36.OpenRecordset("tClients")
Set Data1.Recordset = rs
Créé le 6 janvier 2003  par Romain Puyfoulhoux

Un code source vous permettant d'imprimer un RichTextBox, avec la gestion des pages, est dans cet article de MSDN.

Créé le 4 septembre 2003  par Romain Puyfoulhoux

Sur une feuille, placez 2 contrôles RichTextBox avec leur texte respectif et un bouton de commande Command1. Placez ensuite ce code dans le module de la form.

vb
Sélectionnez
Private Function ConcatRTF(RTF1 As String, RTF2 As String) As String
 
    ConcatRTF = Left(RTF1, InStrRev(RTF1, "}") - 1) & Mid(RTF2, 2)
 
End Function
 
 
Private Sub Command1_Click()
 
    With Me.RichTextBox1
        .TextRTF = ConcatRTF(.TextRTF, Me.RichTextBox2.TextRTF)
        .Refresh
    End With
 
End Sub
Créé le 26 avril 2004  par Bazoom

Ce n'est pas possible avec la ComboBox standard. Par contre, celle incluse dans le composant Microsoft Forms 2.0 dispose de cette fonctionnalité.

  • Ajoutez le composant Microsoft Forms 2.0 Object Library dans votre projet. Cela a pour effet d'ajouter des contrôles dans la boîte à outils, dont le contrôle ComboBox (il a le même nom que la ComboBox standard de VB mais il est plus évolué).
  • Ajoutez un nouveau contrôle ComboBox sur votre Form.
  • Modifiez sa propriété ColumnCount à la valeur souhaitée.

L'exemple suivant montre comment remplir une ComboBox à 3 colonnes :

vb
Sélectionnez
Dim i As Integer
 
For i = 0 To 4
    cboTest.AddItem
    cboTest.List(i, 0) = "Lig " & i & " Col 0"
    cboTest.List(i, 1) = "Lig " & i & " Col 1"
    cboTest.List(i, 2) = "Lig " & i & " Col 2"
Next i

Pour qu'une colonne soit cachée, il suffit de mettre sa largeur à 0. Par exemple pour qu'une ComboBox ait 3 colonnes et que les deux premières soient cachées :

vb
Sélectionnez
Combo1.ColumnCount = 3
Combo1.ColumnWidths = "0" & ";" & "0" & ";" & "3975"
Créé le 26 avril 2004  par Alexandre Lokchine, Khany

Habituellement, une ComboBox se déroule quand l'utilisateur clique dessus. Si vous voulez la dérouler avec du code, placez ces déclarations dans un module :

vb
Sélectionnez
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                     (ByVal hwnd As Long, ByVal wMsg As Long, _
                                      ByVal wParam As Long, lParam As Any) As Long
 
Private Const CB_SHOWDROPDOWN = &H14F
 
Public Sub DerouleCombo(handle As Long)
    SendMessage handle, CB_SHOWDROPDOWN, True, ByVal 0
End Sub

Voici comment par exemple dérouler automatiquement une combo quand elle reçoit le focus :

vb
Sélectionnez
Private Sub Combo1_GotFocus()
DerouleCombo Combo1.hwnd
End Sub
Créé le 28 juin 2004  par Romain Puyfoulhoux

Copiez ce code dans un module standard :

vb
Sélectionnez
Private Const CB_GETLBTEXTLEN = &H149
Private Const CB_SHOWDROPDOWN = &H14F
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_MSGMAX = &H15B
Private Const CB_SETITEMHEIGHT = &H153
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                     (ByVal hwnd As Long, ByVal wMsg As Long, _
                                      ByVal wParam As Long, lParam As Any) As Long
 
Public Sub LargeurCombo(hwnd As Long, largeur As Long)
 
    SendMessage hwnd, CB_SETDROPPEDWIDTH, largeur, ByVal 0
 
End Sub

La procédure LargeurCombo modifie la largeur de la zone de déroulement de la combo dont le handle est passé en paramètre. Pour la tester, posez une combo sur une form et placez code dans le module de la form :

vb
Sélectionnez
Private Sub Form_Load()
 
    Dim i As Long
 
    For i = 1 To 20
        Combo1.AddItem "ligne " & i
    Next
 
    LargeurCombo Combo1.hwnd, 300
 
End Sub
Créé le 28 juin 2004  par Alexandre Lokchine, ThierryAIM

Ceci est possible en faisant appel à l'api MoveWindow. Copiez ce code dans module standard.

vb
Sélectionnez
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, _
                                                  ByVal x As Long, ByVal y As Long, _
                                                  ByVal nWidth As Long, ByVal nHeight As Long, _
                                                  ByVal bRepaint As Long) As Long
 
Public Sub SetCtrlHeight(vCtrl As Control, vHeight As Long)
 
    Dim xForm As VB.Form, xCont As Object, XScaleMode As ScaleModeConstants
 
    'Trouve où est situé le contrôle (Formulaire et Contenant)
    Set xForm = vCtrl.Parent
    Set xCont = vCtrl.Container
 
    'Enlève le contrôle de son contenant pour le mettre sur la form
    Set vCtrl.Container = xForm
 
    'Sauvegarde ScaleMode avant de le modifier
    XScaleMode = xForm.ScaleMode
 
    'Met ScaleMode du formulaire en Pixels car MoveWindow utilise les pixels
    xForm.ScaleMode = vbPixels
 
    'Redimentionne la fenêtre du ComboBox
    MoveWindow vCtrl.hwnd, vCtrl.Left, vCtrl.Top, vCtrl.Width, vHeight, 1
 
    'Remet ScaleMode à sa valeur initiale
    xForm.ScaleMode = XScaleMode
 
    'Remet le contrôle dans son contenant initial
    Set vCtrl.Container = xCont
 
End Sub

Voici comment donner à la zone de déroulement d'une combo box une hauteur de 180 pixels :

vb
Sélectionnez
Private Sub Form_Load()
 
    Dim xHeight As Long
    xHeight = 180 ' en pixel : affiche 12 lignes en Font MS sans Serif taille 8
    Call SetCtrlHeight(Combo1, xHeight)
 
End Sub
Créé le 28 juin 2004  par ThierryAIM

Cette fonctionnalité consiste à sélectionner automatiquement l'élément de la liste dont le début correspond aux caractères saisis dans la combo. Si aucun n'élément ne correspond, rien n'est sélectionné.

Copiez tout d'abord ces déclarations au début du module de la form :

vb
Sélectionnez
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                     (ByVal hwnd As Long, ByVal wMsg As Long, _
                                      ByVal wParam As Long, lParam As Any) As Long
Private Const CB_FINDSTRING = &H14C

Tout le reste du code se situe dans la procédure de l'événement KeyPress, qui a lieu chaque fois qu'un caractère est entré :

vb
Sélectionnez
Private Sub Combo1_KeyPress(KeyAscii As Integer)
 
    Dim Trouve As Long, Position As Integer, Taille As Integer, strTemp As String
 
    With Me.Combo1
        If KeyAscii = 8 Then
            If .SelStart = 0 Then Exit Sub
            .SelStart = .SelStart - 1
            .SelText = ""
        Else
            Position = .SelStart
            strTemp = .Text
        End If
        .SelText = Chr(KeyAscii)
        Trouve = SendMessage(.hwnd, CB_FINDSTRING, 0, ByVal .Text)
        If Trouve = -1 Then
            'les trois lignes suivantes doivent être enlevées en cas de non correspondance possible
            .Text = strTemp
            .SelStart = Position
            .SelLength = (Len(.Text) - Position)
            KeyAscii = 0
            Exit Sub
        Else
            Position = .SelStart
            Taille = Len(.List(Trouve)) - Len(.Text)
            .SelText = .SelText & Right(.List(Trouve), Taille)
            .SelStart = Position
            .SelLength = Taille
            KeyAscii = 0
        End If
    End With
 
End Sub
Créé le 28 juin 2004  par Jean-Marc Rabilloud, Romain Puyfoulhoux

Si l'un des éléments d'une ListBox est trop long pour pouvoir être affiché entièrement dans la liste, un ascenseur horizontal serait bien utile, mais ce contrôle n'a pas de propriété permettant de l'indiquer. Afin qu'un ascenseur soit créé quand l'un des éléments dépasse la largeur de la liste, copiez tout d'abord ce code dans un module.

vb
Sélectionnez
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, _
                                                                  ByVal nCount As Long, lpRect As RECT, _
                                                                  ByVal wFormat As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                     (ByVal hwnd As Long, ByVal wMsg As Long, _
                                      ByVal wParam As Long, lParam As Any) As Long
 
Private Const LB_SETHORIZONTALEXTENT = &H194
Private Const DT_CALCRECT = &H400
Private Const SM_CXVSCROLL = 2
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Public Sub ApplyScrollBar(ByVal hdc As Long, MaListe As ListBox)
 
    Dim compteur As Long, Nlargeur As Long, LargText As Long, sysScrollWidth As Long
    Dim rcText As RECT
 
    sysScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
    For compteur = 0 To MaListe.ListCount - 1
           DrawText hdc, MaListe.List(compteur), -1&, rcText, DT_CALCRECT
           LargText = rcText.Right + sysScrollWidth
           If LargText >= Nlargeur Then
                Nlargeur = LargText
           End If
    Next compteur
    SendMessage MaListe.hwnd, LB_SETHORIZONTALEXTENT, Nlargeur, ByVal 0&
 
End Sub

Ensuite, appelez la procédure ApplyScrollBar chaque fois que vous ajoutez ou supprimez un élément dans la liste, ce qui aura pour effet d'afficher ou de supprimer l'ascenseur et d'actualiser sa taille s'il reste visible. Pour tester ce code, placez une listbox sur une form et placez ce code dans le module de la form :

vb
Sélectionnez
Private Sub Form_Load()
 
    List1.AddItem "fjkzlqgj fjekljdsk"
    List1.AddItem "fjkzlqgj fjekd jfskdlqgjslkdgjklsq fjdsk"
    List1.AddItem "fjkzlqgj fjekl"
 
    ApplyScrollBar Me.hdc, List1
 
End Sub
Créé le 28 juin 2004  par Jean-Marc Rabilloud, Khany, Romain Puyfoulhoux

Si vous préférez ne pas utiliser la collection Microsoft Forms 2.0, il existe néanmoins une manière propre de présenter une entrée multicolonnes dans une ListBox:

Les items doivent être insérés dans la liste séparés par des tabulations, par exemple:

vb
Sélectionnez
 List1.Additem "champ1" & vbTab & "champ2" & vbTab & "champ3"

Si la police est à chasse fixe (Courrier, par exemple), les colonnes sont alors correctement alignées, mais si la police est à chasse variable (ce qui est le cas la plupart du temps), il faut utiliser les API de Windows pour faire un alignement correct, comme suit:

Placez ce code dans un module:

vb
Sélectionnez
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                    (ByVal hwnd As Long, ByVal wMsg As Long, _
                                    ByVal wParam As Long, lParam As Any) As Long
 
Public Const LB_SETTABSTOPS = &H192

Utilisez ensuite le code suivant pour produire une liste avec des champs alignés proprement:

vb
Sélectionnez
Private Sub Form_Load()
 
    'ce tableau va contenir les positions des tabulations (ce qui equivaut
    'à la largeur des colonnes
    ReDim tabstop(0 To 2) As Long
 
    'on positionne les tabulations
    tabstop(0) = 90
    tabstop(1) = 130
    tabstop(2) = 185
 
    'on efface puis on réinitialise les tabulations
    Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&) 
    Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 3, tabstop(0))
    List1.Refresh
 
End Sub
Créé le 6 septembre 2004  par Alexandre Lokchine

Nous allons voir comment placer dans une combo ou une liste les valeurs contenues dans un champ d'une base de données en vue d'une sélection d'un enregistrement. La liaison directe avec la source de données évite la boucle de lecture du recordset ainsi que l'instruction additem et facilite la lecture des autres champs de l'enregistrement sélectionné.

Placez un contrôle DataCombo ou DataList sur une feuille et initialisez une connexion à une base de données; ensuite, insérez ce code :

vb
Sélectionnez
Set DataCombo1.DataSource = rst
Set DataCombo1.RowSource = rst
DataCombo1.ListField = "MonChamp"     'nom du champ

Si l'on désire voir l'élément sélectionné en surbrillance, il faut ajouter au code précédent :

vb
Sélectionnez
DataCombo1.DataField = "MonChamp"

Pour placer le recordset sur l'élément sélectionné et récupérer la valeur des autres champs de cet enregistrement :

vb
Sélectionnez
Private Sub DataCombo1_Click()
 
  If DataCombo1 <> "" Then
      rst.Bookmark = DataCombo1.SelectedItem
  End If
 
  Text1.Text = rst.Fields("AutreChamp")   ' nom d'un champ quelconque dans la base
End Sub
Créé le 6 septembre 2004  par Khany, Romain Puyfoulhoux

Chaque noeud d'un TreeView possède une clé qui est un identifiant unique, assigné au moment de l'insertion et dont on se sert ici afin de tester l'existence d'un noeud:

vb
Sélectionnez
If Treeview.Nodes(cle_a_verifier) Is Nothing Then
    'le noeud n'existe pas
End If
Créé le 28 juin 2004  par Alexandre Lokchine

Contrairement à une opinion largement répandue, il est possible de changer la couleur d'arrière-plan d'un TreeView.

Placez ces déclarations dans un module :

vb
Sélectionnez
Private Const GWL_STYLE As Long = (-16)
Private Const TVS_HASLINES As Long = 2
Private Const TV_FIRST As Long = &H1100
Private Const TVM_SETBKCOLOR As Long = (TV_FIRST + 29)
Private Const TVM_SETTEXTCOLOR As Long = (TV_FIRST + 30)
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                    (ByVal hwnd As Long, ByVal wMsg As Long, _
                                     ByVal wParam As Long, lParam As Any) As Long
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
                                      (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
                                      (ByVal hwnd As Long, ByVal nIndex As Long, _
                                       ByVal dwNewLong As Long) As Long

Ensuite, placez la procédure suivante dans la section générale du formulaire:

vb
Sélectionnez
Public Sub SetTreeViewArrPlan(ByVal treeview As MSComctlLib.treeview, ByVal couleur As Long)
 
    Dim style As Long, noeud As Node
 
    'Changement de l'arrière-plan du treeview
    Call SendMessage(treeview.hwnd, TVM_SETBKCOLOR, 0, ByVal couleur)
 
    'réinitialisation de l'arbre
    style = GetWindowLong(treeview.hwnd, GWL_STYLE)
 
    'Si l'arbre a des lignes, on les désactive temporairement pour que
    'l'arrière-plan se redessine proprement, puis on les réactive
 
    If style And TVS_HASLINES Then
        SetWindowLong treeview.hwnd, GWL_STYLE, style Xor TVS_HASLINES
        SetWindowLong treeview.hwnd, GWL_STYLE, style
    End If
 
    'on change la couleur de fond des noeuds
    For Each noeud In treeview.Nodes
        noeud.BackColor = couleur
    Next
 
End Sub

L'appel se fait comme suit :

vb
Sélectionnez
Dim couleur As Long
couleur = vbRed
SetTreeViewArrPlan TreeView1, couleur
Créé le 28 juin 2004  par Alexandre Lokchine, Romain Puyfoulhoux

Dans un module standard, placez ce code :

vb
Sélectionnez
Public Const RELIEF = 1
Public Const ENCADREMENT = 2
 
Public Sub Ombrage(Feuille As Form, Ctrl As Control, Effet As Integer, OmbreLarg As Integer, OmbreCoul As Long)
 
    Dim CouleurOmbre As Long
    Dim LargeurOmbre As Integer
    Dim Largeur As Integer
    Dim Taille As Integer
 
    LargeurOmbre = OmbreLarg
    CouleurOmbre = OmbreCoul
    Largeur = Feuille.DrawWidth
    Taille = Feuille.ScaleMode
    Feuille.DrawWidth = 1
 
    Select Case Effet
        Case ENCADREMENT
            Feuille.Line (Ctrl.Left + LargeurOmbre, Ctrl.Top + LargeurOmbre)- _
                          Step(Ctrl.Width - 1, Ctrl.Height - 1), CouleurOmbre, BF
 
        Case RELIEF
            Feuille.Line (Ctrl.Left - LargeurOmbre, Ctrl.Top - LargeurOmbre)- _
                          Step(Ctrl.Width - 1, Ctrl.Height - 1), CouleurOmbre, BF
    End Select
 
    Feuille.DrawWidth = Largeur
    Feuille.ScaleMode = Taille
 
End Sub

Posez, par exemple, un PictureBox sur votre feuille, et placez ce code dans le module de la feuille :

vb
Sélectionnez
Private Sub Form_Paint()
 
    Ombrage Me, Picture1, ENCADREMENT, 10, QBColor(5) 'contour du cadre accentué
    Ombrage Me, Picture1, RELIEF, 10, QBColor(5) 'effet d'enfoncement de l'image
 
End Sub
Créé le 28 juin 2004  par Khany

La fonction ci-dessous renvoie Vrai si le contrôle passé en paramètre contient une image.

vb
Sélectionnez
Public Function ImagePresente(controle As Control) As Boolean
 
    ImagePresente = (controle.Picture.Handle > 0)
 
End Function
Créé le 28 juin 2004  par Jean-Marc Rabilloud, Alexandre Lokchine

Il peut être utile de savoir si une propriété existe pour un contrôle donné, dans une boucle par exemple, afin d'éviter les erreurs

Insérez ce code dans la section déclaration de votre form ou dans un module :

vb
Sélectionnez
Public Function ExistProperty(Obj As Object, ByVal PropertyName As String) As Boolean 
    On Error Resume Next 
    CallByName Obj, PropertyName, VbGet 
    ExistProperty = (Err.Number = 0) 
    Err.Clear 
End Function

Exemple d'utilisation :

vb
Sélectionnez
Dim Ctrl As Control
    For Each Ctrl In Me.Controls
        If Not ExistProperty(Ctrl, "ForeColor") Then
            Debug.Print "La propriété ForeColor n'existe pas pour le controle " & Ctrl.Name
        End If
    Next
Créé le 2 mai 2006  par DarkVader, ThierryAIM

Dans Projets -> Composants -> Cocher Microsoft Windows Common Controls 6.0 (SP4) Le code suivant ne fonctionne que sous Win 2000 et supérieur mais le deuxième code proposé palie à ce manque et fonctionne sous Win 98.
Sur une feuille, poser un contrôle ToolBar et copier le code dans la partie déclaration :

vb
Sélectionnez
Private Type POINTAPI 
    X As Long 
    Y As Long 
End Type 
 
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long 
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
                          ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) 
 
Private Sub Form_Load() 
    Dim i As Integer 
    Dim btn As Button 
 
    ' Ajoute un objets Button au contrôle Toolbar. 
    Set btn = Toolbar1.Buttons.Add(Caption:="Test", Style:=tbrDropdown) 
    ' Ajoute deux objets ButtonMenu à l'objet Button. 
    btn.ButtonMenus.Add Text:="Option 1" 
    btn.ButtonMenus.Add Text:="Option 2" 
End Sub 
 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) 
    Dim dx As Long 
    Dim dy As Long 
    Dim Point As POINTAPI 
 
    With Button 
        If .Style = tbrDropdown Then 
            If .ButtonMenus.Count = 0 Then Exit Sub 
            dx = (Me.Left + Toolbar1.Left + .Left + .Width) / Screen.Width * 65535 
            dy = (Me.Top + Toolbar1.Top + .Top + .Height) / Screen.Height * 65535 
            GetCursorPos Point 
            mouse_event &H8003, dx, dy, 0, 0 
            mouse_event &H8004, dx, dy, 0, 0 
            SetCursorPos Point.X, Point.Y 
        End If 
    End With 
End Sub 
 
Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu) 
    Select Case ButtonMenu.Index 
    Case 1 
        MsgBox "Vous avez cliquer sur l'option 1" 
    Case 2 
        MsgBox "Vous avez cliquer sur l'option 2" 
    End Select 
 
End Sub

Pour Win 98 : Avec un bouton normal et le déroulement d'un menu quand on clique dessus.

vb
Sélectionnez
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) 
 
    If Button.Index = 1 Then 
        PopupMenu lemenu, , Button.Left, Button.Top + Button.Height + Toolbar1.Top + 12 
    End If 
 
End Sub

Le menu est créé dans l'éditeur de menu de la form.

Créé le 13 juin 2005  par Bazoom, Romain Puyfoulhoux, ThierryAIM

Créez un fichier Manifest comme suit: (dans le bloc note de windows par exemple)

 
Sélectionnez
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> 
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> 
<assemblyIdentity 
    type="win32" 
    name="Microsoft.Windows.Editeur" 
    processorArchitecture="X86" 
    version="4.4.0.0" 
/> 
<description>Entrez la description du programme ici</description> 
<dependency> 
    <dependentAssembly> 
        <assemblyIdentity 
            type="win32" 
            name="Microsoft.Windows.Common-Controls" 
            language="*" 
            processorArchitecture="X86" 
            version="6.0.0.0" 
            publicKeyToken="6595b64144ccf1df" 
        /> 
    </dependentAssembly> 
</dependency> 
</assembly>

et sauvegardez-le avec le nom et l'extension du fichier exécutable pour lequel il est destiné. Exemple: J'ai un programme qui s'appelle "CSBar.exe", si je veux faire un manifest pour ce fichier exécutable, le fichier manifest aura pour nom "CSBar.exe.manifest" Pour finir, dans le module de code de votre Form principale, mettez le code suivant:

vb
Sélectionnez
'Déclaration des API 
Private Declare Function InitCommonControls Lib "comctl32.dll" () As Long 
 
Private Sub Form_Initialize() 
    'Initialise les controles pour leur donner le style de Windows XP. 
    InitCommonControls 
End Sub

Compilez votre programme et lancez-le, vous pourrez voir que vos contrôles on désormais le style de Windows XP.

Mis à jour le 2 mai 2006  par CSoldier

Lien : Donner le style Windows XP aux contrôles dans l'IDE de Visual Basic 6

Mettez ce code dans un module :

vb
Sélectionnez
Private Type SHFILEOPSTRUCT 
    hWnd As Long 
    wFunc As Long 
    pFrom As String 
    pTo As String 
    fFlags As Integer 
    fAnyOperationsAborted As Boolean 
    hNameMappings As Long 
    lpszProgressTitle As String 
End Type 
 
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long 
Private Const FO_COPY = &H2 
Private Const FOF_ALLOWUNDO = &H40 
 
 
Public Sub CopyFileWindowsWay(SourceFile As String, DestinationFile As String) 
 
Dim lngReturn As Long 
Dim typFileOperation As SHFILEOPSTRUCT 
 
    With typFileOperation 
        .hWnd = 0 
        .wFunc = FO_COPY 
        .pFrom = SourceFile & vbNullChar & vbNullChar 
        .pTo = DestinationFile & vbNullChar & vbNullChar 
        .fFlags = FOF_ALLOWUNDO 
    End With 
    lngReturn = SHFileOperation(typFileOperation) 
    If lngReturn <> 0 Then 
        MsgBox Err.LastDllError, vbCritical Or vbOKOnly 
    Else 
        If typFileOperation.fAnyOperationsAborted = True Then 
            MsgBox "Operation Failed", vbCritical Or vbOKOnly 
        End If 
    End If 
 
End Sub

Appel de la procédure :

vb
Sélectionnez
Call CopyFileWindowsWay(App.Path & "\denoxaut.732", App.Path & "\messanger\denoxaut.732")
Créé le 13 juin 2005  par Jean-Marc Rabilloud, ridan

Ouvrir un module (page de code) :
- menu Projet puis Composants
- Onglet Contrôle
- Cochez Microsoft Common Dialog Control

Dans la barre d'outils, choisissez le control Microsoft Common Dialog Control et placez le sur le formulaire. Nous le nommons Dlg.

Placez le code suivant dans un module (action click du bouton Btn_Chercher) :

 
Sélectionnez
Private Sub Btn_Chercher_Click()
    With dlg
        .DialogTitle = "selectionner un fichier" 'titre de la boite
        .FileName="*.txt" 'on recherche un fichier d'extension txt
        .initDir="c:\" 'repertoire par defaut
        .CancelError = false 'pour ne pas partir en erreur si on click sur annuler
        .ShowOpen
    End With
    'txtPath est la zone de texte recevant le chemin du fichier
    txtPath = dlg.FileName 
End Sub
Mis à jour le 22 décembre 2008  par olivier]

Lien : Afficher la boîte de dialogue ouvrir afin de récupérer le nom et le chemin du fichier sélectionné
Lien : Afficher la boîte de dialogue Enregistrer sous afin de récupérer le nom et le chemin du fichier sélectionné
Lien : Comment sélectionner plusieurs extensions dans le filtre d'un CommonDialog ?

Pour utiliser le CommonDialog, il faut cocher le composant Microsoft Common Dialog Control 6.0 (SP2) et utiliser ce code :

vb
Sélectionnez
CommonDialog1.Filter = "Fichier zip et rar (*.zip,*.rar)|*.zip;*.rar"
Créé le 13 juin 2005  par Tofalu

Placer un composant RichTextBox sur votre feuille (Microsoft Rich Textbox Control 6.0 (SP4)) et le code suivant :

vb
Sélectionnez
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _ 
     ByVal hwnd As Long, _ 
     ByVal wMsg As Long, _ 
     ByVal wParam As Long, _ 
     ByRef lParam As Any) As Long 
 
Private Const WM_PASTE As Long = &H302 
 
Private Sub Form_Load() 
Clipboard.Clear 
Clipboard.SetData LoadPicture("c:\bitmap.bmp") 
SendMessage RichTextBox1.hwnd, WM_PASTE, 0, 0 
End Sub
Créé le 13 juin 2005  par ridan

Une Combobox standard en VB6 n'a pas de propriété "MatchEntry"
Il est toutefois possible de faire de l'auto-complétion dans une Combobox avec le code suivant :

vb
Sélectionnez
Private Sub Combo1_Change() 
    Dim i As Integer, start As Integer 
    start = Len(Combo1.Text) 
    For i = 0 To Combo1.ListCount - 1 
        If Left(Combo1.List(i), start) = Combo1.Text Then 
            Combo1.Text = Combo1.List(i) 
        End If 
    Next 
    Combo1.SelStart = start 
    Combo1.SelLength = Len(Combo1.Text) 
End Sub

Une autre méthode en utilisant l'API Windows :

vb
Sélectionnez
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, lParam As Any) As Long
 
Private Const CB_ERR As Long = (-1)
Private Const CB_SELECTSTRING As Long = &H14D
 
Private Sub Combo1_Change()
    Dim start As Integer
    start = Len(Combo1.Text)
    If SendMessage(Combo1.hwnd, CB_SELECTSTRING, ByVal Combo1.ListIndex, ByVal Combo1.Text) <> CB_ERR Then
        Combo1.SelStart = start
        Combo1.SelLength = Len(Combo1.Text)
    End If
End Sub
Créé le 2 mai 2006  par ThierryAIM
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2013 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.