RechercheV en VBA

Merci pour les , et pour avoir passé le sujet en résolu !

Bonne continuation pour la suite de ton projet !

dhany

Bonjour Dhany,

Mon projet évolue encore et j'aurai besoin de savoir si il est possible et facile de rajouter des secteurs supplémentaires.

Soit des accueils en plus.

J'ai déjà ACCUEIL 81 et ACCUEIL 82

Je souhaiterai rajouter ACCUEIL 12 / ACCUEIL 46 / ACCUEIL 48

Avec à chaque fois un lien des pages:

RECHERCHE pour ACCUEIL 82

RECHERCHE81 pour ACCUEIL 81

RECHERCHE12 pour ACCUEIL 12

RECHERCHE46 pour ACCUEIL 46

RECHERCHE48 pour ACCUEIL 48

Merci d'avance.

Bonjour Blanchounet,

Oui, ta demande est possible ; sur les 3 feuilles "ACCUEIL" supplémentaires "12 / 46 / 48", tu dois ajouter la colonne "Fax" (si elle n'y est pas déjà) ; ensuite, envoie ce nouveau fichier et je ferai la suite (qui sera assez longue, car y'aura beaucoup de choses à faire).

dhany

Bonjour Dhany,

Comme convenu:

Merci pour tout .

Bonjour Blanchounet,

Je te retourne ton fichier modifié :

Tes 3 feuilles supplémentaires sont prêtes !

dhany

Bonjour Dhany,

Merci pour ton retour.

Juste une question, pourrais-tu me faire la même chose pour le défilement des feuilles ACCUEIL 12 /46/48.

En tout cas merci pour ton implication.

Bonjour Blanchounet,

Tu a écrit :

pourrais-tu me faire la même chose pour le défilement des feuilles ACCUEIL 12 / 46 / 48.

Je n'ai pas compris cette demande, car normalement, c'est déjà fait : cela grâce au Module0 et au code VBA des feuilles où se trouve la liste à faire défiler ; ce code VBA est le même pour toutes les feuilles :

Option Explicit

Private WithEvents wb As Workbook

Private Sub ComboBox1_Change()
  GetInfos
End Sub

Private Sub ComboBox1_GotFocus()
  Set wb = ThisWorkbook
  MakeScrollableWithMouseWheel(ComboBox1) = True
End Sub

Private Sub ComboBox1_LostFocus()
  MakeScrollableWithMouseWheel(ComboBox1) = False
End Sub

Private Sub wb_BeforeClose(Cancel As Boolean)
  If MakeScrollableWithMouseWheel(ComboBox1) Then
    MakeScrollableWithMouseWheel(ComboBox1) = False
  End If
End Sub

Je viens d'vérifier la présence de tout ce code pour les 3 feuilles en questions (fenêtre Visual Basic, en haut à gauche) :

* Feuil11 (ACCUEIL 46)

* Feuil12 (ACCUEIL 48)

* Feuil5 (ACCUEIL 12)

sur mon fichier, la molette de la souris permet de changer d'item dans la liste, mais ça défile pas uniquement car y'a pas assez d'entreprises : la liste est trop courte ! sur ton fichier réel avec plus d'entreprises, ça doit faire le défilement.

si vraiment ça marche toujours pas, alors il faut que tu joignes ton fichier actuel (celui où tu as le problème).

si c'est autre chose que tu demandes, je ne vois pas ce que c'est.

dhany

Bonjour Blanchounet,

suite à ton dernier MP, voici pourquoi l'erreur se produisait : sur la feuille "ACCUEIL 81" quand tu cliques dans la zone blanche de la liste déroulante, aucune sélection n'a été faite dans la liste, donc ActiveSheet.ComboBox1.ListIndex = -1 ; comme ensuite j'ajoute 1, ça passe à 0 ; mais sur une feuille de calcul, une ligne n° 0 n'existe pas, et voilà pourquoi ça plante !

ayant trouvé la cause du problème, j'ai trouvé comment le régler ; c'est dans Module2, cette sub :

Sub GetInfos()
  Dim Plg$, col As Byte: Plg$ = "C10:G16, C20:G21": FX = "RECHERCHE"
  Select Case ActiveSheet.Name
    Case "ACCUEIL 81": col = 3: FX = FX & "81"
    Case "ACCUEIL 82": col = 10: Plg = Plg & ", C23:G24"
    Case Else: Exit Sub
  End Select
  Application.ScreenUpdating = 0: Range(Plg).ClearContents
  lg0 = ActiveSheet.ComboBox1.ListIndex: If lg0 = -1 Then Exit Sub
  With LEPM.Cells(lg0 + 1, col)
    lg1 = .Value
    If lg1 > 0 Then lg2 = .Offset(, 1): FillPlg [C10], 7
    lg1 = .Offset(, 2)
    If lg1 > 0 Then lg2 = .Offset(, 3): FillPlg [C20], 2
    If col = 3 Then Exit Sub
    lg1 = .Offset(, 4)
    If lg1 > 0 Then lg2 = .Offset(, 5): FillPlg [C23], 2
  End With
End Sub

regarde les 3 lignes qui suivent le End Select.

dhany

Rechercher des sujets similaires à "recherchev vba"