vivre-motion
Menu de recherche déroulant Excel

SKU: VM-70019
Prix habituel: € 0,00 EUR
Prix habituel: ~~€ 3,00 EUR~~
Prix soldé: € 0,00 EUR
Prix unitaire: par
Taxes incluses. Frais d'expédition calculés à l'étape de paiement.
Variantes de produits
Quantité
Menu contextuel déroulant Excel moderne

Menu de sélection consultable

Le menu de sélection interactif VBA remplace la DropZone standard par une interface moderne.

Le menu de sélection moderne permet également une recherche en temps réel avec Astérisque Wildcards.
Opération d'interface

Appuyez sur Espace pour * Astérisque Wildcard
Appuyez sur la flèche vers le bas pour sélectionner l'élément
Configuration de la source d'entrée et des couleurs

Appuyez sur ALT+F11, ouvrez CONTEXT_MENU et modifiez la valeur des données d'entrée à la vôtre. Ajustez les couleurs du thème dans le SELECT_MENU UserForm en haut.
Code source VBA


'/////////////////////////////////////////////// ////////////////////////////////////
Option explicite
Const privé COLOR_HOVER_ITEM_FONT = &HFFFFFF
Agent privé COLOR_HOVER_ITEM_BACK = &HEADE47
Const privé COLOR_DEFAULT_ITEM_FONT = &H412C2B
Const privé COLOR_SEARCH_FIELD_FONT = &H412C2B
Agent privé COLOR_PLACEHOLDER_FONT = &H968372
Agent privé COLOR_SMILEY_BACK = &H968372
Const privé COLOR_SLIDER_DEFAULT_BACK = &HEADE47
Const privé COLOR_SLIDER_HOVER_BACK = &HCAC0BF
Const privé COLOR_SLIDERAERA_HOVER_BACK = &HCAC0BF
Const privé COLOR_SLIDERAERA_DEFAULT_BACK = &HFAF5F2
Const privé COLOR_COUNTER_FONT = &H968372
Agent privé COLOR_SLIDERAERA_PLACEHOLDER_BACK = &HFFFFFF
'/////////////////////////////////////////////// ////////////////////////////////////
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal H_WINDOW As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Déclarer PtrSafe Function ReleaseCapture Lib "user32" () As Long
Private Declare PtrSafe 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 Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Privé Déclarer la fonction PtrSafe GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long) As Long
Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal H_WINDOW As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal H_WINDOW As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hWnd As Long, ByVal attr As Integer, ByRef attrValue As Integer, ByVal attrSize As Integer) As Long
Private Declare PtrSafe Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hWnd As Long, ByRef NEWMARGINS As MARGINS) As Long
'/////////////////////////////////////////////// ////////////////////////////////////
Agent privé GWL_STYLE = (-16)
Privé Const WS_CAPTION = &HC00000 '//// WS_BORDER Ou WS_DLGFRAME
Const privé WS_BORDER = &H800000
Privé Const GWL_EXSTYLE As Long = (-20) '//// DÉCALAGE DU STYLE ÉTENDU DE LA FENÊTRE
Private Const WS_EX_DLGMODALFRAME As Long = &H1 '//// CONTRÔLE SI LA FENÊTRE A UNE ICÔNE
Privé Const SC_CLOSE As Long = &HF060
Privé Const SW_SHOW As Long = 5
Const privé WS_EX_LAYERED = &H80000
Const privé LWA_COLORKEY = &H1
Privé Const LWA_ALPHA = &H2
Privé Const WS_EX_TRANSPARENT = &H20&
'/////////////////////////////////////////////// ////////////////////////////////////
Énumération privée ESetWindowPosStyles
    SWP_SHOWWINDOW = &H40
    SWP_HIDEWINDOW = &H80
    SWP_FRAMECHANGED = &H20 '//// CADRE MODIFIÉ ENVOYER WM_NCCALCSIZE
    SWP_NOACTIVATE = &H10
    SWP_NOCOPYBITS = &H100
    SWP_NOMOVE = &H2
    SWP_NOOWNERZORDER = &H200 '// NE FAIT PAS DE COMMANDE DE PROPRIÉTAIRE Z
    SWP_NOREDRAW = &H8
    SWP_NOREPOSITION = SWP_NOOWNERZORDER
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
    SWP_DRAWFRAME = SWP_FRAMECHANGED
    HWND_NOTOPMOST = -2
Fin de l'énumération
'/////////////////////////////////////////////// ////////////////////////////////////
MARGES de type privé
    GAUCHE Aussi longtemps
    TOP Aussi longtemps
    DROITE Aussi longtemps
    BAS aussi longtemps
Type de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Const privé HTCAPTION = 2
XWNDFORM privé, XWNDFORMEX aussi longtemps
Const privé WM_NCLBUTTONDOWN = &HA1
'/////////////////////////////////////////////// ////////////////////////////////////
Dim ENV_SLOTS Aussi Long
Estomper SLIDE_LEFT_POS aussi longtemps
Estomper SLIDE_TOP_POS aussi longtemps
Estomper SELECT_SLIDE_ARRAY
Estomper SELECT_SLIDE_ARRAY_MAX aussi longtemps
Estomper ARROW_SELECT en tant que chaîne
Dim I_SELECT en tant qu'entier
'/////////////////////////////////////////////// ////////////////////////////////////
Sous UserForm_Activate privé ()

    Moi.ScrollTop = 700
    
    Appelez INIT_STAGE
    
    Me.ScrollTop = 0
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé INIT_STAGE()
'
' Moi.TOP = ActiveCell.TOP + Application.TOP
' Moi.GAUCHE = ActiveCell.GAUCHE + Application.GAUCHE
    
    SMILEY.Visible = Faux
    
    ENV_SLOTS = 6
    
    I_SELECT = 0
    
    Appelez RESET_STAGE
    
    SEARCH_FIELD.ForeColor = COLOR_SEARCH_FIELD_FONT
    SMILEY.ForeColor = COLOR_SMILEY_BACK
    SEARCH_FIELD_PLACEHOLDER.ForeColor = COLOR_PLACEHOLDER_FONT
    COUNTER.ForeColor = COLOR_COUNTER_FONT
    SLIDE_AREA_PLACEHOLDER.BackColor = COLOR_SLIDERAERA_PLACEHOLDER_BACK
    
    Dim I As Long
    
    Pour I = 1 Vers ENV_SLOTS

        Controls("HOVER_" & I).BorderStyle = fmBorderStyleNone

    Ensuite je
    
    SEARCH_FIELD.Texte = ""
    SEARCH_FIELD.SetFocus
    
    Appelez HYPER_SEARCH(SEARCH_FIELD.Texte)
    
    Appelez REFRESH_SLIDE(0)
    
    SLIDER.TOP = SLIDE_AREA.TOP
    
    Appelez SLIDER_RESET(Moi.SLIDE_AREA, Moi.SLIDER)
        
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub UserForm_MouseDown (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    Si Bouton = 1 Alors
   
        ReleaseCapture
        EnvoyerMessage XWNDFORM, WM_NCLBUTTONDOWN, HTCAPTION, 0&

    Fin si
   
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé HOVERME (ByVal ITEM As Long)

    Controls("BACK_" & ITEM).BackColor = COLOR_HOVER_ITEM_BACK
    Controls("BACK_" & ITEM).Visible = True
    Controls("ITEM_" & ITEM).ForeColor = COLOR_HOVER_ITEM_FONT

Sous-titre de fin

Sous UserForm_Initialize privé ()

    Dim ISTYLE, HWNDFORM Aussi longtemps
    Dim btrans comme octet
    btrans = 128
    Estomper NOUVELLES MARGES comme MARGES
    
    HWNDFORM = FindWindow(vbNullString, Me.Caption) '//// GET WINDOW

    ISTYLE = GetWindowLong(HWNDFORM, GWL_STYLE) '//// FENÊTRE DE BASE STYLE DRAPEAUX POUR LE FORMULAIRE
    ISTYLE = ISTYLE And Not WS_CAPTION '//// AUCUNE ZONE DE LÉGENDE
    SetWindowLong HWNDFORM, GWL_STYLE, ISTYLE '//// DÉFINIR LES STYLES DE FENÊTRE DE BASE

    ISTYLE = GetWindowLong(HWNDFORM, GWL_EXSTYLE) '//// CONSTRUIRE UN STYLE DE FENÊTRE ÉTENDU
    ISTYLE = ISTYLE et non WS_EX_DLGMODALFRAME '//// SANS FRONTIÈRE

    SetWindowLong HWNDFORM, GWL_EXSTYLE, ISTYLE
    
    XWNDFORM = FindWindow("ThunderDFrame", vbNullString) '//// OBTENIR NOUVELLE FENÊTRE

    DwmSetWindowAttribute XWNDFORM, 2, 2, 4 '//// DWMAPI

    Avec NOUVELLESMARGES
        .BAS = 1 '//// -1
        .GAUCHE = 1 '//// -1
        .DROITE = 1 '//// -1
        .TOP = 1 '//// -1
    Terminer par

    DwmExtendFrameIntoClientArea XWNDFORM, NOUVELLESMARGES '//// DWMAPI
    
    DrawMenuBar HWNDFORM '//// NETTOYER LA BARRE DE MENUS

    Moi.Largeur = Moi.Largeur - 12
    Moi.Taille = Moi.Taille - 19
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub UserForm_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Appelez RESET_STAGE
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé SEARCH_FIELD_KeyDown (ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Si KeyCode = 40 Alors SELECT_DOWN
    
    Si KeyCode = 38 Alors SELECT_UP
        
    Si KeyCode = 13 Alors
    
        SELECT_NAME = ARROW_SELECT
        Décharge moi
    
    Fin si
    
    Si KeyCode = 27 Alors

        SELECT_NAME = ""
        Décharge moi
    
    Fin si
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé SELECT_DOWN()

    Si Me.Controls("ITEM_" & 1).Visible = False Alors Quitter Sub
    
    Si I_SELECT <> ENV_SLOTS Alors
    
        I_SELECT = I_SELECT + 1
        
        Appelez RESET_STAGE
        
        Si Me.Controls("ITEM_" & I_SELECT).Visible = False Alors I_SELECT = I_SELECT - 1

        Appelez HOVERME(I_SELECT)
        ARROW_SELECT = Me.Controls("ITEM_" & I_SELECT).ControlTipText
    
    Fin si

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé SELECT_UP()

    Si Me.Controls("ITEM_" & 1).Visible = False Alors Quitter Sub
    
    Si I_SELECT >= 2 Alors
    
        I_SELECT = I_SELECT - 1

        Appelez RESET_STAGE
        Appelez HOVERME(I_SELECT)
        ARROW_SELECT = Me.Controls("ITEM_" & I_SELECT).ControlTipText
    
    Fin si

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé SEARCH_FIELD_Change()

    CHAMP_RECHERCHE.Texte = Remplacer(CHAMP_RECHERCHE.Texte, " ", "*")
    
    Si SEARCH_FIELD.Text = "" Alors
        SEARCH_FIELD_PLACEHOLDER.Text = "tel"
    Autre
        SEARCH_FIELD_PLACEHOLDER.Texte = ""
    Fin si
    
    Appelez HYPER_SEARCH(SEARCH_FIELD.Texte)
    
    Appelez REFRESH_SLIDE(0)
    
    SLIDER.TOP = SLIDE_AREA.TOP
    
    Appelez RESET_STAGE

    ARROW_SELECT = ""
    
    I_SELECT = 0
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub UserForm_QueryClose (Annuler en tant qu'entier, CloseMode en tant qu'entier)
 
    Si CloseMode = 0 Alors SELECT_NAME = ""

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé RESET_STAGE()

    Dim I As Long
    
    Appelez SLIDER_RESET(Moi.SLIDE_AREA, Moi.SLIDER)
    
    Pour I = 1 Vers ENV_SLOTS

        Controls("BACK_" & I).Visible = False
        
        Controls("ITEM_" & I).ForeColor = COLOR_DEFAULT_ITEM_FONT

    Ensuite je
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-titre privé HOVER_1_Click()
    
    SELECT_NAME = ITEM_1.ControlTipText
    Décharge moi
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-titre privé HOVER_2_Click()
    
    SELECT_NAME = ITEM_2.ControlTipText
    Décharge moi
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-titre privé HOVER_3_Click()
    
    SELECT_NAME = ITEM_3.ControlTipText
    Décharge moi
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-titre privé HOVER_4_Click()
    
    SELECT_NAME = ITEM_4.ControlTipText
    Décharge moi
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-titre privé HOVER_5_Click()
    
    SELECT_NAME = ITEM_5.ControlTipText
    Décharge moi
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-titre privé HOVER_6_Click()
    
    SELECT_NAME = ITEM_6.ControlTipText
    Décharge moi
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub HOVER_1_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Appelez RESET_STAGE
    Appelez HOVERME(1)
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub HOVER_2_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Appelez RESET_STAGE
    Appelez HOVERME(2)
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub HOVER_3_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Appelez RESET_STAGE
    Appelez HOVERME(3)
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub HOVER_4_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Appelez RESET_STAGE
    Appelez HOVERME(4)
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub HOVER_5_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Appelez RESET_STAGE
    Appelez HOVERME(5)
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub HOVER_6_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Appelez RESET_STAGE
    Appelez HOVERME(6)
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Public Sub SLIDE_AREA_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    Appelez SLIDE_AREA_MOUSE_MOVE(Moi.SLIDE_AREA, Moi.SLIDER)

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub SLIDER_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
    Estomper SCROLL_POS aussi longtemps
    
    SCROLL_POS = Rond((((SELECT_SLIDE_ARRAY_MAX - ENV_SLOTS) * CONTROL_SLIDER(Me.SLIDER, Me.SLIDE_AREA, X, Y, Button)) / 100), 0)
    
    Appelez REFRESH_SLIDE(SCROLL_POS)
    
    Appelez SLIDER_MOUSE_MOVE(Moi.SLIDE_AREA, Moi.SLIDER)

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub SLIDE_AREA_MouseDown (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        
    Estomper SCROLL_POS aussi longtemps
    
    SCROLL_POS = Rond((((SELECT_SLIDE_ARRAY_MAX - ENV_SLOTS) * CONTROL_SLIDE_AREA(Me.SLIDER, Me.SLIDE_AREA, X, Y)) / 100), 0)
    
    Appelez REFRESH_SLIDE(SCROLL_POS)
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub SLIDER_MouseDown (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    Si Bouton = 1 Alors SLIDE_LEFT_POS = X
    Si Bouton = 1 Alors SLIDE_TOP_POS = Y

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé REFRESH_SLIDE(ByVal SCROLL_POS As Long)

    Dim I As Long

    Moi.COUNTER.Caption = SELECT_SLIDE_ARRAY_MAX
    
    Si SELECT_SLIDE_ARRAY_MAX = 0 Alors
        SMILEY.Visible = Vrai
    Autre
        SMILEY.Visible = Faux
    Fin si
    
    Pour je = 1 Vers ENV_SLOTS 'MAX_ITEMS
    
        Si je <= SELECT_SLIDE_ARRAY_MAX Alors

            Si SELECT_SLIDE_ARRAY(SCROLL_POS + I, 1) <> "" Alors

                Controls("HOVER_" & I).Visible = True
                Controls("ITEM_" & I).Caption = SELECT_SLIDE_ARRAY(SCROLL_POS + I, 1)
                Controls("ITEM_" & I).ControlTipText = SELECT_SLIDE_ARRAY(SCROLL_POS + I, 1)
                Controls("ITEM_" & I).Visible = True
                
            Autre
    
                'Contrôles("SLOT_" & I).Visible = Vrai
                Controls("HOVER_" & I).Visible = False
                Controls("ITEM_" & I).Visible = False
                
            Fin si
            
        Autre

            Controls("HOVER_" & I).Visible = False
            Controls("ITEM_" & I).Visible = False
                
        Fin si

    Ensuite je

    Si SELECT_SLIDE_ARRAY_MAX < ENV_SLOTS Alors

        SLIDER.Visible = Faux
        SLIDE_AREA.Visible = Faux

    Autre

        SLIDER.Visible = Vrai
        SLIDE_AREA.Visible = Vrai

    Fin si

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Fonction privée CONTROL_SLIDER(ByRef SLIDER As Object, ByRef SLIDE_AREA As Object, ByVal X As Single, ByVal Y As Single, ByVal BUTTON_HOLD As Integer) As Long

    'En cas d'erreur, reprendre le suivant

    Atténuer SNG_LEFT en tant que célibataire
    Atténuer SNG_TOP en tant que célibataire
    Estomper SCROLL_POS en tant que célibataire
    Dim SCROLL_RANGE comme simple

    Si BUTTON_HOLD = 1 Alors

            '//// ZONE GAUCHE
            SNG_LEFT = (SLIDER.LEFT + X) - SLIDE_LEFT_POS

            Si SNG_LEFT < SLIDE_AREA.LEFT Alors SNG_LEFT = SLIDE_AREA.LEFT

                Si (SNG_LEFT + SLIDER.Width) > (SLIDE_AREA.LEFT + SLIDE_AREA.Width) Alors

                    SNG_LEFT = SLIDE_AREA.LEFT + SLIDE_AREA.Width - SLIDER.Width

                Fin si

            '//// HAUTEUR
            SNG_TOP = (SLIDER.TOP + Y) - SLIDE_TOP_POS

            Si SNG_TOP < SLIDE_AREA.TOP Alors SNG_TOP = SLIDE_AREA.TOP

                Si (SNG_TOP + SLIDER.Height) > (SLIDE_AREA.TOP + SLIDE_AREA.Height) Alors

                    SNG_TOP = SLIDE_AREA.TOP + SLIDE_AREA.Hauteur - SLIDER.Hauteur

                Fin si

            SLIDER.Déplacer SNG_LEFT, SNG_TOP

    Fin si

    '//// GAMME DE DIAPOSITIVE
    SCROLL_POS = Arrondi(SLIDER.TOP - SLIDE_AREA.TOP, 0)
    SCROLL_RANGE = SLIDE_AREA.Hauteur - SLIDER.Hauteur
    CONTROL_SLIDER = Arrondi(((100 * SCROLL_POS) / SCROLL_RANGE), 0) ' POUR CENT

Fonction de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Fonction privée CONTROL_SLIDE_AREA(ByRef SLIDER As Object, ByRef SLIDE_AREA As Object, ByVal X As Single, ByVal Y As Single) As Long

    'En cas d'erreur, reprendre le suivant

    Atténuer SNG_LEFT en tant que célibataire
    Atténuer SNG_TOP en tant que célibataire
    Estomper SCROLL_POS en tant que célibataire
    Dim SCROLL_RANGE comme simple
    Atténuer SET_POS aussi longtemps

    SET_POS = Y - SLIDER.Height + SLIDE_AREA.TOP

    Si SET_POS < SLIDE_AREA.TOP Alors

        SLIDER.TOP = SLIDE_AREA.TOP

    Autre

        CURSEUR.TOP = SET_POS

    Fin si

    Si ((SLIDE_AREA.TOP + SLIDE_AREA.Height) - (SLIDER.TOP + SLIDER.Height)) < 30 Alors

        SLIDER.TOP = (SLIDE_AREA.TOP + SLIDE_AREA.Height) - SLIDER.Height

    Fin si

    '//// GAMME DE DIAPOSITIVE
    SCROLL_POS = Arrondi(SLIDER.TOP - SLIDE_AREA.TOP, 0)
    SCROLL_RANGE = SLIDE_AREA.Hauteur - SLIDER.Hauteur
    CONTROL_SLIDE_AREA = Arrondi(((100 * SCROLL_POS) / SCROLL_RANGE), 0) ' POUR CENT

Fonction de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Sous-marin privé SLIDE_AREA_MOUSE_MOVE(ByVal SLIDE_AREA_ITEM As Object, ByVal SLIDER_ITEM As Object)

    SLIDE_AREA_ITEM.BackColor = COLOR_SLIDERAERA_HOVER_BACK
    SLIDER_ITEM.BackColor = COLOR_SLIDER_DEFAULT_BACK

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub SLIDER_MOUSE_MOVE(ByVal SLIDE_AREA_ITEM As Object, ByVal SLIDER_ITEM As Object)

    SLIDE_AREA_ITEM.BackColor = COLOR_SLIDERAERA_DEFAULT_BACK
    SLIDER_ITEM.BackColor = COLOR_SLIDER_HOVER_BACK

Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub SLIDER_RESET(ByVal SLIDE_AREA_ITEM As Object, ByVal SLIDER_ITEM As Object)

    SLIDE_AREA_ITEM.BackColor = COLOR_SLIDERAERA_DEFAULT_BACK
    SLIDER_ITEM.BackColor = COLOR_SLIDER_DEFAULT_BACK
    
Sous-titre de fin
'/////////////////////////////////////////////// ////////////////////////////////////
Private Sub HYPER_SEARCH(ByVal SEARCHTEXT As String)

    Dim I As Long
    Dim S aussi longtemps
    Dim R aussi longtemps
    Atténuer X aussi longtemps
    Estomper FUSION_STRING en tant que chaîne
    Estomper HYPER_SEARCH(99) en tant que chaîne
    Estomper HYPER_SEARCH_MAX aussi longtemps
    Dim SPLIT_CACHE
    Dim CONVERSION_CHECK comme booléen
    
    Effacer HYPER_SEARCH
    CONVERSION_CHECK = Faux
    
    '//// CRÉER UN TABLEAU HYPERRECHERCHE
    Si InStr(SEARCHTEXT, "*") <> 0 Alors
        
        SPLIT_CACHE = Diviser(RECHERCHETEXTE, "*")
        
        Pour R = 0 Vers UBound(SPLIT_CACHE)
        
            HYPER_SEARCH(R + 1) = SPLIT_CACHE(R)
            HYPER_SEARCH_MAX = R + 1
        
        R suivant

    Autre
    
        HYPER_SEARCH(1) = RECHERCHETEXTE
        HYPER_SEARCH_MAX = 1
    
    Fin si
    '//// CRÉER UN TABLEAU HYPERRECHERCHE
    
    S = 0
    
    Si UBound(SELECT_ARRAY) < 6 Alors
    
        Redim SELECT_SLIDE_ARRAY(6, 1)
    
    Autre
        
        Redim SELECT_SLIDE_ARRAY(UBound(SELECT_ARRAY), 1)
        
    Fin si
    
    
    Pour I = 1 Vers UBound(SELECT_ARRAY)

        Si SELECT_ARRAY(I, 1) <> "" Alors
        
            FUSION_STRING = ""
            FUSION_STRING = FUSION_STRING & SELECT_TABLEAU(I, 1) & "|"
        
            Pour R = 1 Vers HYPER_SEARCH_MAX
            
                Si InStr(LCase(FUSION_STRING), LCase(HYPER_SEARCH(R))) <> 0 Alors
                
                    CONVERSION_CHECK = Vrai
                    
                Autre
                
                    CONVERSION_CHECK = Faux
                    Quitter pour

                Fin si
                
            R suivant
            
            Si CONVERSION_CHECK = Vrai Alors
                
                S = S + 1
                
                Pour X = 1 Vers UBound(SELECT_ARRAY, 2)
                    
                    SELECT_SLIDE_ARRAY(S, X) = SELECT_ARRAY(I, X)
                
                X suivant
                
            Fin si
        
        Fin si

    Ensuite je
    
    SELECT_SLIDE_ARRAY_MAX = S

Sous-titre de fin
Article ajouté au panier

Menu de recherche déroulant Excel

Menu contextuel déroulant Excel moderne

Menu de sélection consultable

Opération d'interface

Configuration de la source d'entrée et des couleurs

Code source VBA

Customer Reviews

Menu de recherche déroulant Excel

Menu contextuel déroulant Excel moderneMenu de sélection consultable

Opération d'interface

Configuration de la source d'entrée et des couleurs

Code source VBA

Customer Reviews

Menu contextuel déroulant Excel moderne

Menu de sélection consultable
