HELP !!! Problème de macro recherche

[r@fz6]

Bonjour, j'aurai besoin d'un p'tit coup de main !!

Je suis chauffeur/livreur et je réalise un fichier client me permettant :

1_ De référencer les clients ainsi que diverses informations (adresses, heures et jours de réception etc...)
>> J'ai créé une liste avec la colone "nom client" > > > OK ca marche

2_ De situer précisément les clients difficiles a trouver (rase campagne...) sur une carte.
>> J'ai créé un lien hypertexte sur la case correspondant au nom du client et hop ! une page Internet s'ouvre avec le plan ou la carte et les diverses infos du client... > > > OK ca marche aussi... mais à améliorer...

Pour l'instant dans mon classeur il n'y a que 2 feuilles... la premiére qui ne sert que de page d'acceuil avec un lien hypertexte qui renvois a la 2ème feuille, la feuille "Répertoire"

1ére question :

J'ai trouvé un code (merci le forum...) pour faire la recherche et ca marche... sauf un truc !! quand la boite de dialogue s'ouvre, et qu'on clic sur "fermer", "annuler" ou que l'on clic "OK" sans remplir le champ "Recherche" ca bug et ca me renvois sur ma page d'accueil... Et j'arrive pas a trouver la ligne de commande qui décon.....

LA ! je bloque... Même en supprimant des lignes au pifométre je trouve pas

2ème question :
Lors de la création d'un nouveau client, et donc d'un nouveau plan, je fais une "mise en page" du plan (pictogramme, mise en couleurs des chemins d'accés etc...) sous Paint (dispo sur tout PC).
Est-il possible d'automatiser la "mise en page" via un bouton qui ouvrirai une boite de dialogue du type "explorateur" pour selectionner le plan numériser et ouvrir directement ce plan sous paint ???

Hop ! le code de la recherche :

Private Sub CommandButton2_Click()
Dim Str_Plage As String
Dim Cel As Range
Dim Feuil As Worksheet
Dim Str_critère As String
Dim X As Byte

Str_Plage = "B12:B112"
Str_critère = InputBox("Nom à rechercher ?")
For Each Feuil In Sheets
For Each Cel In Feuil.Range(Str_Plage)
If UCase(Cel) Like "*" & UCase(Str_critère) & "*" Then
Feuil.Activate
Cel.Activate
X = MsgBox("Nom """ & Str_critère & """ trouvé :" & Chr(13) & _
"Sur la feuille : " & Feuil.Name & Chr(13) & _
"à la cellule : " & Cel.Address(0, 0) & Chr(13) & Chr(13) & _
"Oui : Arrêter la recherche" & Chr(13) & _
"Non : Continuer la recherche " & Chr(13), vbDefaultButton2 + _
vbQuestion + vbYesNo, "MOT TROUVÉ")
Select Case X
Case 6
Feuil.Activate
Cel.Activate
Exit Sub
Case 2
Exit Sub
Case Else 'Non=7
End Select
End If
Next Cel
Next Feuil
MsgBox ("Désolé pas de résultat")
End Sub

Merci d'avance pour vos réponses et désolé d'avoir été un peu long...

 

[gilbert_RGI]

Re : HELP !!! Problème de macro recherche

Bonjour

déjà pour le code

Private Sub CommandButton2_Click()

    Dim Str_Plage As String
    Dim Cel As Range
    Dim Feuil As Worksheet
    Dim Str_critère As String
    Dim X As Byte

    Str_Plage = "B12:B112"
    Str_critère = InputBox("Nom à rechercher ?")
    If Str_critère = "" Then GoTo fin
    For Each Feuil In Sheets
        For Each Cel In Feuil.Range(Str_Plage)
            If UCase(Cel) Like "*" & UCase(Str_critère) & "*" Then
                Feuil.Activate
                Cel.Activate
                X = MsgBox("Nom """ & Str_critère & """ trouvé :" & Chr(13) & _
                           "Sur la feuille : " & Feuil.Name & Chr(13) & _
                           "à la cellule : " & Cel.Address(0, 0) & Chr(13) & Chr(13) & _
                           "Oui : Arrêter la recherche" & Chr(13) & _
                           "Non : Continuer la recherche " & Chr(13), vbDefaultButton2 + _
                                                                      vbQuestion + vbYesNo, "MOT TROUVÉ")
                Select Case X
                Case 6
                    Feuil.Activate
                    Cel.Activate
                    Exit Sub
                Case 2
                    Exit Sub
                Case Else    'Non=7
                End Select
            End If
        Next Cel
    Next Feuil
    MsgBox ("Désolé pas de résultat")
fin:
End Sub

Cdlt

RGI

 

[r@fz6]

Re : HELP !!! Problème de macro recherche

Bonjour !! et surtout super merci gilbert_RGI !!! quelle rapidité et efficacité !!! c'est coOOL !! en plus c'été le plus urgent et important !

Des idées pour la suite ??

Encore merci !!

 

[r@fz6]

Re : HELP !!! Problème de macro recherche

Me revoici, avec une p'tite modification a apporter au code qui me sert a fermer et enregistrer mon classeur... mon problème, je voudrai que la copie de sauvegarde datée s'enrgistre dans un dossier "Sauvegarde"

Voici le code :

Public Sub CommandButton1_Click() 'copie sauvegarde classeur
Dim nom As String
nom = "ChroPilote " & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & " à " & Hour(Time) & "h" & Minute(Time) & "min" & Second(Time) & "sec" & ".xls"
Sheets(1).Select
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
rep = MsgBox("ChroPilote à été sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")
ThisWorkbook.Save
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
Application.Quit
End Sub


Merci par avance !!

 

[gilbert_RGI]

Re : HELP !!! Problème de macro recherche

Bonjour

à la place de ActiveWorkbook.Path mettre le chemin du dossier de sauvegarde

ex : ActiveWorkbook.SaveCopyAs "c:\sauvegarde\" & nom

Salutations

RGI

 

[r@fz6]

Re : HELP !!! Problème de macro recherche

Merciiiiiiiiiii !!! c'est cool !! le p'ti logiciel est presque parfait !!.... Presque.... quelqu'un aurait une idée pour l'intégration des cartes ? (ouvrir une fenétre explorateur pour choisir un plan et l'ouvrir automatiquement sous Paint pour ajouter les infos supplémentaires)

Encore merci Gilbert_RGI !!!

 

[gilbert_RGI]

Re : HELP !!! Problème de macro recherche

Bonjour

essaie ceci dans un module standard

Declare 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


Sub SelectionFichier()
           LongFilename = Application.GetOpenFilename("Pictures Files (*.jpg), *.jpg,(*.*),*.*")
      fich = CStr(LongFilename)
      rep = ShellExecute(0, "open", fich, "", "", 0)
End Sub

ce code n'ouvre pas obligatoirement avec paint mais avec l'application par defaut

Salutations

RGI

 

[gilbert_RGI]

Re : HELP !!! Problème de macro recherche

Si tu veux vraiement ouvrir avec paint

toujours dans un module standard

Declare 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


Sub SelectionFichier()
      LongFilename = Application.GetOpenFilename("Pictures Files (*.jpg), *.jpg,(*.*),*.*")
      fich = CStr(LongFilename)
      rep = Shell("C:\windows\system32\mspaint.exe " & fich, vbNormalFocus)
End Sub

Bonne soirée

RGI

 

[r@fz6]

Re : HELP !!! Problème de macro recherche

Heu... désolé mais je n'arrive pas a faire fonctionner le code.... pourrai tu me le redonner mais dans le code complet STP ?

 

[gilbert_RGI]

Re : HELP !!! Problème de macro recherche

Bonjour

Il est complet et il fonctionne chez moi
juste mettre dans un module standard

je t'envoie un fichier dans la matinée

Cdlt

RGI

 

[gilbert_RGI]

Re : HELP !!! Problème de macro recherche

Voilà un exemple

Cdlt

RGI

 

[r@fz6]

Re : HELP !!! Problème de macro recherche

Bonjour !! Alors ca marche... presque... ca n'ouvre pas Paint ??
mais déja c'est cool !!! encore merci !!! Y aurait il un autre code avec le même résultat ?

J'ai un autre probléme, mais je vais poster un autre sujet car je m'écarte trop de celui ci.... bref...

Merci encore a toi Gilbert !!! super efficace et rapide !!

 

[gilbert_RGI]

Re : HELP !!! Problème de macro recherche

Regarde le chemin de mspaint.exe chez moi il se trouve dans le system32 peut-être que chez toi il est à une autre place ??

Sub SelectionFichier()
LongFilename = Application.GetOpenFilename("Pictures Files (*.jpg), *.jpg,(*.*),*.*")
fich = CStr(LongFilename)
If fich = False Then Exit Sub
rep = Shell("C:\windows\system32\mspaint.exe " & fich, vbNormalFocus)
End Sub

ah peut-être : une autre obligation il faut que le fichier soit enregistré sur ton disque dur !!!! avant de l'ouvrir avec excel

Cdlt

RGI