Discussion :

[couscous.bio.nic]

Bonjour à toutes et à tous,

Question simple, réponse simple ?
En VBA je commence petit à petit à saisir la chose mais je n'ai pas encore la faciliter de comprendre mes erreurs.

Arriveriez vous à me guider pour que mon code soit fonctionnel ?

(Tout ceci est visible sur l'image 1 ci-jointe)
Le projet consiste à partir du bouton à cliquer "Ouverture base de données" sur l'Excel "Fiche coût construction.xls" apparaissent le "Userform1" que j'ai crée avec deux menus déroulants et un bouton à cliquer.
Le "combobox1" permet de choisir le type d'ouvrage disponible sur la plage M2 à O2
Le "combobox2" permet de choisir la région selon la disponibilité de la combobox1 qui choisira la plage M3 à M9 , N3 à N9 ou O3 à O9
Une fois les deux menus déroulants choisi, cliquer sur le bouton "Valider et fermer" qui permet de fermer le "Userform1" et ...*

(Tout ceci est visible sur l'image 2 ci-jointe)

...* d'ouvrir l'Excel "base données.xls" pour y chercher sur le bon onglet, la bonne plage de cellules contenant des liens à ouvrir.

Exemple pratique :

Je sélectionne sur la combobox1 --> "logements neufs" (disponible sur cellule M2)
Je sélectionne sur la combobox2 --> "IDF" (disponible sur cellule M3)
Je clique sur le bouton valider et fermer

Automatiquement la base de données s'ouvre et va sélectionner la plage B3 à Z3 afin d'y ouvrir chaque lien s'y trouvant.


A ce jour,
le "Userform1" s'ouvre mais rien n'est disponible dans aucune des deux "combobox" et le bouton "valider et fermer" ne fonctionne pas
la "base de données" s'ouvre mais les liens ne s'ouvrent pas

Merci pour toutes aides et/ou réponses que vous pourriez m'apporter

Ci-bas le code que j'ai fais :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub ouvrebasedetous()
 
'permet d'ouvrir la base de données en second plan
Workbooks.Open ("C:\Users\User\Desktop\00 Economie de la construction interne Nomade\test\00 base de données (version 1).xlsx")
Workbooks("Fiche coût construction 3.0.xslm").Sheets("1").Activate
 
UserForm1.Show 'permet d'ouvrir le UserForm1 à deux menus déroulants ainsi qu'un bouton valider/fermer
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub UserForm1_Initialize() 'permet d'incrémenter le UserForm1
'déclaration des variables
Dim colonne As Integer
Dim i As Integer, j As Integer
 
colonne = 14 'affectation du numéro de colonne à 14 car première données en colonne M
 
Worksheets("Fiche coût construction 3.0.xslm").Sheets("1").Range ("M2: P2") 'sur cet Excel à cette page dans les cellules choisies ci-trouve la liste du premier menu déroulant
 
Do While Cells(14, colonne).Value <> "" 'on réalise une boucle qui va charger les noms de cette première liste déroulante et tant qu'il y a des valeurs dans la ligne 2, on charge les nouveaux noms
 
        UserForm1.ComboBox1.AddItem Cells(2, colonne).Value
        colonne = colonne + 1 'on incrémente le numéro de colonne afin de passer à la colonne de droite
    Loop
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub ComboBox1_Change() ' permet de choisir ce qui apparaitra dans les menus déroulants
 
'initialisation des variables
i = 14
 
UserForm1.ComboBox2.Clear 'On vide la liste déroulante de la ComboBox2 afin de ne pas cumuler les enregistrements
 
Worksheets("Fiche coût construction 3.0.xslm").Sheets("1").Range ("M2: P2") 'sur cet Excel à cette page dans les cellules choisies ci-trouve la liste du premier menu déroulant
 
Do While Cells(14, i).Value <> "" 'On boucle pour récupérer chaque choix du ComboBox2 selon la ComboBox1
'On teste que le nom de la ComboBox1 dans la liste déroulante soit identique à la cellule active
 
        If Cells(14, i).Value = ComboBox1.Value Then 'Si oui
 
        Cells(14, i).Select 'on selection la cellule de la ComboBox1
 
        colonne = ActiveCell.Column 'On récupère son positionnement par le n° de colonne
    End If
i = i + 1 'on incrémente le numéro de colonne
Loop
j = 3 'On initialise à 3 le numéro de ligne, le premier choix de la ComboBox2 se trouve en ligne 3
Do While Cells(j, colonne).Value <> "" 'On récupère les lignes pour récupérer les noms de la ComboBox2
    UserForm1.ComboBox2.AddItem Cells(j, colonne) 'On charge la liste déroulant de la ComboBox2 avec les noms de la ComboBox2
    j = j + 1 'On incrémente le numéro de ligne
Loop
ComboBox1.ListIndex = 0 'On affiche la première valeur par défaut
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Valideretfermer()
 
Activate.Sub afficheratio()  'Une fois les choix de menu déroulant fait on clique sur le bouton à clicker "valideretfermer" qui lance la macro "Sub afficheratio"
 
Unload Me 'Le userform1 se ferme
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub afficheratio()
 
'Doit permettre (une fois "valideretfermer" clicker) selon les choix du menu déroulant d'ouvrir les fiches ratios accessible depuis worksheet(base de données.xls).sheets(?).range(?)
 
    'Si une fois après avoir cliquer sur valideretfermer les combobox ont choisi "Logements neufs" et "IDF" Alors on ouvrent les liens ce trouvant sur le fichier base de données.xls de l'onglet "A" sur les cellules "B3 à Z3"
 
    If ComboBox1.Value = "Logements neufs" And ComboBox2.Value = "IDF" Then
    Worksheets("base de données.xls").Sheets("A").Range("B3:Z3").Hyperlinks.Follow = True
 
    If ComboBox1.Value = "Logements neufs" And ComboBox2.Value = "Bretagne" Then
    Worksheets("base de données.xls").Sheets("A").Range("B49:Z49").Hyperlinks.Follow = True
 
    If ComboBox1.Value = "Logements neufs" And ComboBox2.Value = "PACA" Then
    Worksheets("base de données.xls").Sheets("A").Range("B95:Z95").Hyperlinks.Follow = True
 
    'If ComboBox1.Value =...
 
Workbooks("Fiche coût construction 3.0.xslm").Sheets("1").Activate
 
 
Private Sub Typeouvrage_Click()
 
End Sub

[EricDgn]

Bonjour,

Pour avancer un peu, un petit exemple montrant comment remplir, mettre à jour, les deux listes déroulantes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
 
Private Sub ComboBox1_Change()
    Dim r As Range, c As Range
    Me.ComboBox2.Clear
    Set r = ThisWorkbook.Worksheets("Feuil1").Range("M3:M10").Offset(0, Me.ComboBox1.ListIndex)
    For Each c In r
        If c.Value <> "" Then
            Me.ComboBox2.AddItem c.Value
        End If
    Next c
End Sub
 
Private Sub UserForm_Initialize()
    Dim r As Range, c As Range
    Set r = ThisWorkbook.Worksheets("Feuil1").Range("M2:P2")
    For Each c In r
        If c.Value <> "" Then
            Me.ComboBox1.AddItem c.Value
        End If
    Next c
End Sub

Cordialement.

[loootoo02]

Bonjour à tous,

je suis novice dans les macros et VBA, mais j'aime bien apprendre! Pourriez-vous m'aider, car je suis dans une impasse.
Je vais essayé d'être clair et précis !

J'ai créé un fichier qui balaye tous les répertoire que j'ai défini, afin d'en ressortir des liens hypertexte dans différentes feuilles excel (tout ca via une macro).
J'ai rassemblé tous ces liens dans une feuille pour les mettre sous forme de matrice.
J'y ai ajouté un userform avec 2 champs de recherche, et je souhaite que lorsque je sélectionne une occurrence trouvé, cela me renvoie vers le fichier du lien hypertexte.

Merci d'avance pour votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
 
Sub TextBox3_Change()
 
   Dim i As Integer
    Dim NbLigne As Integer
    Dim NomCherche As String
 
    Me.ListBox1.Clear
 
    Range("D6:D500").Interior.ColorIndex = 0
    Range("D6:D500").Font.ColorIndex = 1
    Range("D6:D500").Font.Bold = False
 
    NbLigne = Feuil12.Range("A10000").End(xlUp).Row
'    Nomrecherche = Me.TextBox3.Value
 
    If Me.TextBox3 <> "" Then
 
        For i = 5 To NbLigne
            If UCase(Feuil12.Cells(i, 4)) Like "*" & UCase(Me.TextBox3.Value) & "*" Then
 '               Cells(i, 4).Interior.Color = RGB(100, 100, 100)
 '               Cells(i, 4).Font.Color = RGB(255, 0, 0)
 '               Cells(i, 4).Font.Bold = True
 
                Me.ListBox1.AddItem Feuil12.Cells(i, 4)
            End If
 
        Next i
 
    End If
 
End Sub

[EricDgn]

Bonjour,

Ceci devrait le faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub TextBox3_change()
 
    Dim i As Integer
    Dim NbLigne As Integer
    Dim NomCherche As String
 
    Me.ListBox1.Clear
 
    With ThisWorkbook.Worksheets("Feuil2")                  '--- la feuille
        .Range("D6:D500").Interior.ColorIndex = 0
        .Range("D6:D500").Font.ColorIndex = 1
        .Range("D6:D500").Font.Bold = False
 
        NbLigne = .Range("D" & .Rows.Count).End(xlUp).Row   '--- dernière ligne colonne D
        NomCherche = "*" & UCase(Me.TextBox3.Value) & "*"   '--- calculé une seule fois
 
        If Me.TextBox3.Value <> "" Then
 
            For i = 5 To NbLigne
                If UCase(.Cells(i, 4)) Like NomCherche Then
     '               .Cells(i, 4).Interior.Color = RGB(100, 100, 100)
     '               .Cells(i, 4).Font.Color = RGB(255, 0, 0)
     '               .Cells(i, 4).Font.Bold = True
 
                    Me.ListBox1.AddItem .Cells(i, 4)
                End If
 
            Next i
 
        End If
    End With
End Sub

Attention que UCASE met en majuscule mais ne supprime pas les accents: UCASE("é") --> "É"

Cordialement.

[loootoo02]

Bonjour Ericdgn,

merci pour ton aide, mais la macro bug.

avec ma macro ca donne :
Dans la liste de mon userform, j'ai bien le texte des cellules où j'ai mes liens hypertexte (après avoir entré quelques caractère de ce que je recherche), mais ce n'est que le texte du lien, et je souhaite avoir les liens hypertexte (de ma recherche) dans cette liste.
Ou alors lorsque je sélectionne une ligne de ma liste, j'aimerais qu'une cellule m'affiche le lien pour pouvoir cliquer dessus.

(le but de cette boite de dialogue est de simplifier l'accès à des documents intranet pour des opérateurs).

Désolés si je ne suis pas assez clair :p

[EricDgn]

Bonjour,

Si j'ai bien compris, faire un double-clic sur un lien de la liste pour ouvrir ce lien:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    ThisWorkbook.FollowHyperlink Address:=Me.ListBox1
    If Err.Number = -2147221014 Then
        MsgBox "Lien erroné"
    ElseIf Err.Number <> 0 Then
        MsgBox "Erreur! " & Err.Description, vbExclamation, "Erreur " & Err.Number
    End If
End Sub

Cordialement.