Créer un bouton recherche et zone de texte pour une base de données excel

**gnain** · 10/03/2015, 11h36

Pour la recherche
remplacer ceci

Code :

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

1
2
3
    Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate

par ceci

Code :

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

1
2
3
     Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate

Pour les liens hypertextes poster votre code modifier, je l'essayerai.

**Jeremy2109** · 10/03/2015, 12h07

Merci Gnain mais ca ne marche pas encore comme j'aimerai :/
Il ne m'affiche qu'une seule ligne et me montre le mot demander. Ce que j'aurais aimé c'est que quand je tape Voile qu'il m'affiche toutes les lignes de la BDD contenant le mot Voile quelque soit ca place dans la phrase.
Merci encore de m'aider voici mon code pour me liens Hypertexte :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Private Sub CommandButton_Ajouter_Click()
    'Coloration des Labels en noir
    Label_TypedeFichier.ForeColor = RGB(0, 0, 0)
    Label_Format.ForeColor = RGB(0, 0, 0)
    Label_Ouvrages.ForeColor = RGB(0, 0, 0)
 
    'Contrôles de contenu
    If TextBox_Format.Value = "" Then 'SI pas de "nom" ...
        Label_Format.ForeColor = RGB(255, 0, 0) 'Label "nom" en rouge
    ElseIf TextBox_Ouvrages.Value = "" Then
        Label_Ouvrages.ForeColor = RGB(255, 0, 0)
    Else
        'Si le formulaire est complet, on insère les valeurs sur la feuille
        Dim no_ligne As Integer, TypedeFichier As String
 
        'Choix de civilité
        For Each bouton_TypedeFichier In Frame_TypedeFichier.Controls
            If bouton_TypedeFichier.Value Then
                TypedeFichier = bouton_TypedeFichier.Caption
            End If
        Next
 
        'no_ligne = N° de ligne de la dernière cellule non vide de la colonne +1
        no_ligne = Range("A65536").End(xlUp).Row + 1
 
        'Insertion des valeurs sur la feuille
        Cells(no_ligne, 1) = TypedeFichier
        Cells(no_ligne, 2) = TextBox_Format.Value
        Cells(no_ligne, 3) = TextBox_Ouvrages.Value
        Cells(no_ligne, 4) = TextBox_Mode_Constructif.Value
        Cells(no_ligne, 5) = TextBox_N°_Document.Value
        Cells(no_ligne, 6) = TextBox_Materiel.Value
        Cells(no_ligne, 7) = TextBox_Engins.Value
        Cells(no_ligne, 8) = TextBox_Element_de_securite.Value
        Cells(no_ligne, 9) = TextBox_Famille.Value
        Cells(no_ligne, 10) = TextBox_Chantier.Value
        Cells(no_ligne, 11).Hyperlinks.Add Anchor:=Selection, Address:= TextBox_Liens_PDF.Value , TextToDisplay:= TextBox_Liens_PDF.Value 
        Cells(no_ligne, 12).Hyperlinks.Add Anchor:=Selection, Address:=  TextBox_Liens_DWG.Value , TextToDisplay:=  TextBox_Liens_DWG.Value        
        'Après insertion, on remet les valeurs initiales
        OptionButton1.Value = True
       TextBox_Format.Value = ""
       TextBox_Ouvrages.Value = ""
       TextBox_Mode_Constructif.Value = ""
       TextBox_N°_Document.Value = ""
       TextBox_Materiel.Value = ""
       TextBox_Engins.Value = ""
       TextBox_Element_de_securite.Value = ""
       TextBox_Famille.Value = ""
       TextBox_Chantier.Value = ""
       TextBox_Liens_PDF.Value = ""
       TextBox_Liens_DWG.Value = ""
    End If
End Sub

et celui que j'ai pour la recherche :

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
Private Sub CommandButton1_Click()
    Dim First_No_Ligne As Integer
    Dim no_ligne As Integer
 
    Sheets("BASE DE DONNEES").Select
    Rows("1:" & Rows.Count).EntireRow.Hidden = False
    Rows("6:" & Rows.Count).EntireRow.Hidden = True
    On Error Resume Next
     'votre mot de recherche apparaît dans ligne suivante
 
     Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
 
    First_No_Ligne = ActiveCell.Row
    no_ligne = First_No_Ligne + 1
 
    If Err.Number Then
        On Error GoTo 0
        Exit Sub
    End If
 
    Selection.EntireRow.Hidden = False
 
    Do
        Cells.FindNext(After:=ActiveCell).Activate
        Selection.EntireRow.Hidden = False
        no_ligne = ActiveCell.Row
 
    Loop Until no_ligne = First_No_Ligne
End Sub

Merci

**gnain** · 10/03/2015, 12h50

pour lien hypertexte voici vos 2 lignes corrigés

Code :

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

1
2
Cells(no_ligne, 11).Hyperlinks.Add Anchor:=Cells(no_ligne, 11), Address:= TextBox_Liens_PDF.Value , TextToDisplay:= TextBox_Liens_PDF.Value 
Cells(no_ligne, 12).Hyperlinks.Add Anchor:=Cells(no_ligne, 12), Address:=  TextBox_Liens_DWG.Value , TextToDisplay:=  TextBox_Liens_DWG.Value

pour la recherche ici cela fonctionne
si j'écrit FOSSE, aucune recherche trouvé car tout en majuscule
si j'écrit Fosse le code en trouve beaucoup qui on le mot Fosse écrit dans la cellule
si j'écrit fosse le code en trouve beaucoup aussi qui on le mot fosse écrit dans la cellule

attention au majuscule et minuscule

**Jeremy2109** · 10/03/2015, 14h07

Merci je viens de vérifier pour la recherche et ca marche merci. Par contre pour le formulaire même en changeant les lignes du code tout mes cellules de la ligne ajouter s'affiche en lien hypertexte. Je ne comprend plus la, pourtant les cellules sont bien ciblées dans le code.

Je voulais savoir aussi comment verrouiller la page et masquer une colonne sans fausser le code car quand je masque et verrouille le code ne marche plus ce qui parait normal est ce que je dois afficher les résultat dans une autre pages?

**gnain** · 10/03/2015, 15h41

Envoyé par Jeremy2109

Merci je viens de vérifier pour la recherche et ca marche merci. Par contre pour le formulaire même en changeant les lignes du code tout mes cellules de la ligne ajouter s'affiche en lien hypertexte. Je ne comprend plus la, pourtant les cellules sont bien ciblées dans le code.

Tu as probablement des cellules que peut importe ce qu'on écrit dedans cela fait un lien hypertexte

essaie de sélectionner une centaine de ligne vide à la fin de ta bdd puis fait un click droit avec ta souris, puis supprimer.
cela supprimera ces cellules définitivement. puis normalement tout devrait entré dans l'ordre.

Envoyé par Jeremy2109

Je voulais savoir aussi comment verrouiller la page et masquer une colonne sans fausser le code car quand je masque et verrouille le code ne marche plus ce qui parait normal est ce que je dois afficher les résultat dans une autre pages?

il faudrait que déverrouille avec un code vba juste avant ta macro, puis reverrouiller par code à la fin de ta macro.
Comme cela ton code pourrait fonctionné et à la fin la plage verrouillé.

même chose pour masqué.

**Jeremy2109** · 10/03/2015, 16h07

Ok je vais faire comme ca par contre j'ai fais ce que tu m'as dis pour le formulaire sélectionner les cellules et supprimer mais cela ne marche pas j'ai toujours le même problème.

Pour la sécurité j'aimerais juste pouvoir masquer la dernière colonne, car certaines personnes ne doivent pas avoir accès à cette colonne mais pouvoir rechercher dessus quand même, sans que mon code soit altéré et que la seule façon de pouvoir avoir accès à cette colonne est de rentrer un code.
J'ai commencé à créer un bouton pour masquer et démasquer la colonne L avec un code, mais ce bouton ne me sers pas à grand chose car lorsque je verrouille la feuille pour empêcher toute modification je suis obliger de sélectionner format colonne, sinon mon code pour le bouton ne marche pas et ma recherche non plus, ce qui revient au départ car même si le bouton et la recherche fonctionne un simple double clique entre les deux colonnes leur suffit pour démasquer la colonne L

**gnain** · 10/03/2015, 16h57

Il ne faut pas un bouton pour masqué
il faut l'intégré à ta macro
voir commentaire au début et à la fin de ce code

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
34
35
36
37
Private Sub CommandButton1_Click()
 
    ' ici mettre ton code pour démasqué et déverrouiller
 
 
    Dim First_No_Ligne As Integer
    Dim no_ligne As Integer
 
    Sheets("BASE DE DONNEES").Select
    Rows("1:" & Rows.Count).EntireRow.Hidden = False
    Rows("6:" & Rows.Count).EntireRow.Hidden = True
    On Error Resume Next
     'votre mot de recherche apparaît dans ligne suivante
 
     Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
 
    First_No_Ligne = ActiveCell.Row
    no_ligne = First_No_Ligne + 1
 
    If Err.Number Then
        On Error GoTo 0
        Exit Sub
    End If
 
    Selection.EntireRow.Hidden = False
 
    Do
        Cells.FindNext(After:=ActiveCell).Activate
        Selection.EntireRow.Hidden = False
        no_ligne = ActiveCell.Row
 
    Loop Until no_ligne = First_No_Ligne
 
    ' ici mettre ton code pour masqué et verrouiller
End Sub

**Jeremy2109** · 11/03/2015, 10h01

Bonjour Gnain et merci beaucoup pour ton aide.

Tout marche comme une horloge et je t'en remercie. Cependant j'aurais juste deux chose à te demander.
La première est que lorsque je rentre mes données dans le formulaire, je suis a chaque fois obligé de remplir mais deux case pour les liens hypertexte alors que parfois je n'ai que un PDF parfois que du DWG et parfois les 2.
La deuxième : J'ai trouvé une formule pour modifier le chemin des liens hypertexte, car ils risquent de déplacer le dossier source sur leur bureau pour pouvoir travailler avec de n'importe ou sans forcement être connecté au serveur de la boite. J'aimerai leur mettre sous userform exemple Textbox1 ancien liens
TextBox2 nouveau liens
valider
MERCI

**gnain** · 11/03/2015, 12h32

Bonjour,
Est-ce que tu veux garder en mémoire l’ancien lien ou l'écraser par le nouveau ?

**Jeremy2109** · 11/03/2015, 13h25

J'aimerais le conserver si possible.

**gnain** · 11/03/2015, 16h07

Envoyé par Jeremy2109

La premiere est que lorsque je rentre mes données dans le formulaire, je suis a chaque fois obligé de remplir mais deux case pour les liens hypertexte alors que parfois je n'ai que un PDF parfois que du DWG et parfois les 2.

mettre un on error resume next juste avant et on error goto 0 juste après
voir code

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Private Sub CommandButton_Ajouter_Click()
    'Coloration des Labels en noir
    Label_TypedeFichier.ForeColor = RGB(0, 0, 0)
    Label_Format.ForeColor = RGB(0, 0, 0)
    Label_Ouvrages.ForeColor = RGB(0, 0, 0)
 
    'Contrôles de contenu
    If TextBox_Format.Value = "" Then 'SI pas de "nom" ...
        Label_Format.ForeColor = RGB(255, 0, 0) 'Label "nom" en rouge
    ElseIf TextBox_Ouvrages.Value = "" Then
        Label_Ouvrages.ForeColor = RGB(255, 0, 0)
    Else
        'Si le formulaire est complet, on insère les valeurs sur la feuille
        Dim no_ligne As Integer, TypedeFichier As String
 
        'Choix de civilité
        For Each bouton_TypedeFichier In Frame_TypedeFichier.Controls
            If bouton_TypedeFichier.Value Then
                TypedeFichier = bouton_TypedeFichier.Caption
            End If
        Next
 
        'no_ligne = N° de ligne de la dernière cellule non vide de la colonne +1
        no_ligne = Range("A65536").End(xlUp).Row + 1
 
        'Insertion des valeurs sur la feuille
        Cells(no_ligne, 1) = TypedeFichier
        Cells(no_ligne, 2) = TextBox_Format.Value
        Cells(no_ligne, 3) = TextBox_Ouvrages.Value
        Cells(no_ligne, 4) = TextBox_Mode_Constructif.Value
        Cells(no_ligne, 5) = TextBox_N°_Document.Value
        Cells(no_ligne, 6) = TextBox_Materiel.Value
        Cells(no_ligne, 7) = TextBox_Engins.Value
        Cells(no_ligne, 8) = TextBox_Element_de_securite.Value
        Cells(no_ligne, 9) = TextBox_Famille.Value
        Cells(no_ligne, 10) = TextBox_Chantier.Value
        on error resume next
        Cells(no_ligne, 11).Hyperlinks.Add Anchor:=Selection, Address:= TextBox_Liens_PDF.Value , TextToDisplay:= TextBox_Liens_PDF.Value 
        Cells(no_ligne, 12).Hyperlinks.Add Anchor:=Selection, Address:=  TextBox_Liens_DWG.Value , TextToDisplay:=  TextBox_Liens_DWG.Value    
        on error goto 0    
        'Après insertion, on remet les valeurs initiales
        OptionButton1.Value = True
       TextBox_Format.Value = ""
       TextBox_Ouvrages.Value = ""
       TextBox_Mode_Constructif.Value = ""
       TextBox_N°_Document.Value = ""
       TextBox_Materiel.Value = ""
       TextBox_Engins.Value = ""
       TextBox_Element_de_securite.Value = ""
       TextBox_Famille.Value = ""
       TextBox_Chantier.Value = ""
       TextBox_Liens_PDF.Value = ""
       TextBox_Liens_DWG.Value = ""
    End If
End Sub

Envoyé par Jeremy2109

La deuxieme : J'ai trouvé une formule pour modifier le chemin des liens hypertexte, car ils risquent de déplacer le dossier source sur leur bureau pour pouvoir travailler avec de n'importe ou sans forcement etre connecté au serveur de la boite. J'aimerai leur mettre sous userform exemple Textbox1 ancien liens
TextBox2 nouveau liens
valider

je ne comprend pas trop ce que tu veux faire mais tu pourrais de servir d'une autre colonne ex: colonne H pour mettre l’ancien lien

**Jeremy2109** · 12/03/2015, 09h35

Bonjour Gnain

C'est vrai que je n'ai pas été très clair

En faite j'aimerai créer un bouton qui t'amène à un userform ca je sais faire, puis que dans le userform il y est 2 textbox et un bouton Modifier ca je sais faire aussi. Ensuite j'ai le code pour modifier le chemin ou une partie du chemin des liens hypertext qui est celle-ci :

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
Sub replace_change_lienhypertext()
Dim plage As Range
Dim oldvalue As String
Dim newvalue As String
Dim c As Range
Dim tempstr As String
 
'A modifier
oldvalue = "http://Ancienserveur"
newvalue = "http://nouveauserveur"
 
Set plage = Selection
For Each c In plage
If c.Hyperlinks.Count > 0 Then
 If InStr(1, c.Hyperlinks(1).Address, oldvalue) > 0 Then
        c.Hyperlinks(1).Address = Replace(c..Hyperlinks(1).Address, oldvalue, newvalue)
   End If
    End If
Next
 
End Sub

J'aimerai si il est possible d'affecter cette macro au textbox pour que dans la première il y est l'ancien lien, la seconde le nouveau et que lorsqu'on click sur modifier tous les chemin des liens soit modifié. En espérant avoir été plus clair

**gnain** · 12/03/2015, 11h44

Dans ce lien qui est dans ta bdd,

I:\07 - SAFE\SAFE SPECIFIQUES GTM BA\200 - Terrassement et canalisations\201 - GTC - Fosse ascenseur\201 - GTC_MOP_01 - Fosse ascenseur.pdf

que veux tu remplacer ?
Est-ce seulement le (I:) ou (I:\07 - SAFE) ou (I:\07 - SAFE\SAFE SPECIFIQUES GTM BA) .....

parce que pour pouvoir remplacer le début d'un lien par un autre il faut savoir ou s'arrêter.

Est-ce que tu veux l'écrire dans le textbox, puis dans une boucle on remplace tout les
liens commençant par le textbox? car si on écrit (I:\07 - SAFE\SAFE SPECIFIQUES GTM BA) ce ne seront
pas toute les lien qui seront remplacer.

**Jeremy2109** · 12/03/2015, 14h23

En faite ce que j'aimerai remplacer c'est ce qu'il y a avant c'est à dire remplacer
C:Users\Nom de l'utilisateur\Desktop\ par \\srvsovcfddso\Groupes\METHODES\

J'ai essayé de tester la macro sur ma BDD et ca ne marche pas les liens ne se modifient, alors que lorsque j'ouvre un nouveau classeur et que j'y ajoute un liens hypertexte celui ci se modifie avec la macro??????????????
Aurais tu une idée de ou le pb peut provenir?

**gnain** · 12/03/2015, 16h47

Envoyé par Jeremy2109

alors que lorsque j'ouvre un nouveau classeur et que j'y ajoute un liens hypertexte celui ci se modifie avec la macro??????????????
Aurais tu une idée de ou le pb peut provenir?

Je ne sais vraiment pas, cela peut dépendre de plusieurs facteurs.
si tu veux attache ton fichier, j'y jetterai un coup d'oeuil ce soir.

**Jeremy2109** · 12/03/2015, 17h32

voici mon fichier merci encore

**gnain** · 12/03/2015, 23h22

Bonjour,
J'ai créé un userform5 qui contient 2 textbox et un bouton

premier textbox lien actuel commençant par ...
2e textbox nouveau lien commençant par ...

A chaque fois qu'il y aura click sur le bouton les textbox seront enregistrer dans la Cellule A1 et la Cellule B1
pour qu'a chaque chargement du userform5 les textbox seront chargé avec ces cellules.

Attention: j'ai remarqué que vous avez des liens
comme par exemple: toto\abc\def...
et d'autre comme: toto/abc/def...

ce ne sont pas les même liens et ne seront pas tous changé car toto\abc\def... n'égale pas toto/abc/def...

en espérant de t'avoir aidé.
voir fichier joint

**Jeremy2109** · 13/03/2015, 09h12

Merci beaucoup Gnain

Créer un bouton recherche et zone de texte pour une base de données excel

Macros et VBA Excel

Discussions similaires

Partager

Partager