Microsoft 365 Coller directement mon N° cherché, APRES formatage dans "InputBox"

Usine à gaz · 12 Octobre 2022

Bonjour à toutes et à tous

J'essaie, comme dit en titre de "Coller directement mon N° cherché, après formatage dans "InputBox""
J'ai tenté encore cette nuit, j'ai fait des recherches sans succès.
Alors, une fois encore, je me tourne vers nos ténors magiques

L'action :
Nous copions des n° sous diverses formes et généralement comme saisis de B6 à B10
Le but est formater le n° comme ceux saisis de de B6 à B10

Ce que je sais faire :
Je fais le formatage et ma recherche - tout fonctionne sans souci
1 - de B6 à B10 : sélection du n° à copier à partir de la barre de formule (pour "imiter" la copie sur un site ou autres sources)
2 - Clic sur "Prépa"; le code met le n° en forme dans "G2" (suppression des espaces et du 0 à gauche s'il existe)
3 - Copie du N° "G2" : sélection dans la barre de formule
4 - Clic sur "Trouve" et collage dans "InputBox".
5 - ok pour recherche

Ce que je voudrais :
Ma réflexion (toujours dans le but d'économiser des clics et pour gains de temps)
Je pense que les 4 opérations pourraient être faites en 1 seul clic :
Mais je ne sais pas coller directement mon N° cherché, avant formatage, le formatage se fait et il se met formaté dans "InputBox"

Je n'y arrive pas. Pourriez-vous m'aider ?
En cas, je joins le fichier test.
Un grand merci à tous,
lionel

sylvanu · 12 Octobre 2022

Re,
Effectivement, c'est dimensionnant.

Peut être avec :

VB:

Function Affichage(N)
' Attention! La référence "Microsoft Form 2.0 Object Library." doit être validée
    With New DataObject
        .GetFromClipboard
        Texte = .GetText(1)
    End With
    Texte = Replace(Texte, " ", "")
    If Left(Texte, 1) = "0" Then Texte = Mid(Texte, 2)
    Affichage = CStr(Texte)
End Function

Pensez bien à activer la référence Microsoft Form 2.0 Object Library.

Usine à gaz · 12 Octobre 2022

Re-Bonjour,
Peut-être une solution ? avec ce fichier joint de notre regretté Boisgontier.
Je vais voir quand j'aurai un moment.

sylvanu · 12 Octobre 2022

Bonjour Lionel,
Toujours aussi peu explicite.
Je tente, voir PJ.
On sélectionne une cellule de B7 à B11, et on clique sur Trouver.
Est ce bien cela que vous cherchez à obtenir ?
( à noter que je ré utilise quasi in extenso votre macro Trouve, je n'ai pas cherché à comprendre )

Usine à gaz · 12 Octobre 2022

Bonjour Sylvanu

Merci pour ton fichier super et bien plus direct que la solution que j'ai trouvé.
Mais il y a un souci : La sélection des n° dans le fichier est juste pour l'exemple.
Nous sélectionnons les n° à copier sur des sites :

Il faudrait que ça fonctionne en prenant en compte le presse-papiers
Se serait super de chez super

sylvanu · 12 Octobre 2022

Re,
Effectivement, c'est dimensionnant.

Peut être avec :

VB:

Function Affichage(N)
' Attention! La référence "Microsoft Form 2.0 Object Library." doit être validée
    With New DataObject
        .GetFromClipboard
        Texte = .GetText(1)
    End With
    Texte = Replace(Texte, " ", "")
    If Left(Texte, 1) = "0" Then Texte = Mid(Texte, 2)
    Affichage = CStr(Texte)
End Function

Pensez bien à activer la référence Microsoft Form 2.0 Object Library.

Usine à gaz · 12 Octobre 2022

Merci Sylvanu, c'est nickel super
Grand merci.

Usine à gaz · 12 Octobre 2022

LOL : je m'aperçois que j'en ai une petite dernière
Pour aller au bout : est-il possible de rechercher également des textes contenus dans les cellules
Par exemple : action contenu dans le texte de "G4" (toujours à partir du presse-papier)

sylvanu · 12 Octobre 2022

Re,
Avec ce que j'ai compris :

VB:

Sub Cherche()
    Nom = Affichage(0)
    If Nom = "" Then Exit Sub
    If InStr(1, [G4], Nom) > 0 Then
        MsgBox Nom & Chr(10) & "est bien présent dans " & Chr(10) & [G4]
    Else
        MsgBox Nom & Chr(10) & "n'est pas présent dans la chaine " & Chr(10) & [G4]
    End If
End Sub

et utilisez plutot cette fonction :

Code:

Function Affichage(N)
' Attention! La référence "Microsoft Form 2.0 Object Library." doit être validée
    With New DataObject
        .GetFromClipboard
        Texte = .GetText(1)
    End With
    Texte = Replace(Texte, " ", "")
    Texte = Replace(Texte, Chr(10), "")
    Texte = Replace(Texte, Chr(13), "")
    If Left(Texte, 1) = "0" Then Texte = Mid(Texte, 2)
    Affichage = CStr(Texte)
End Function

Comme ça, ça marche aussi en copiant une cellule, je nettoie la chaine en supprimant les chr(10) chr(13) qui trainent.

job75 · 12 Octobre 2022

Bonjour Lionel, sylvanu, le forum,

Cette macro crée simplement une MFC dans chaque feuille :

VB:

Sub Trouve()
Dim v, w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
Workbooks.Add 'nouveau document
ActiveSheet.Paste 'colle ce qui est dans le presse-papiers
v = Val(Replace([A1], " ", ""))
ActiveWorkbook.Close False
On Error GoTo 0
v = 33 & v
For Each w In Worksheets
    w.Cells.FormatConditions.Delete 'RAZ
    If v <> "330" Then
        w.UsedRange.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=" & v
        w.UsedRange.FormatConditions(1).Interior.ColorIndex = 44 'orange
    End If
Next
End Sub

A+

Usine à gaz · 12 Octobre 2022

Bonjour Gérard
Quel plaisir de te retrouver
Je regarde et je reviens te dire...

Usine à gaz · 12 Octobre 2022

Merci Gérard
Me voilà avec une troisième possibilité...

Usine à gaz · 12 Octobre 2022

sylvanu à dit:

Re,
Avec ce que j'ai compris :

VB:

Sub Cherche()
    Nom = Affichage(0)
    If Nom = "" Then Exit Sub
    If InStr(1, [G4], Nom) > 0 Then
        MsgBox Nom & Chr(10) & "est bien présent dans " & Chr(10) & [G4]
    Else
        MsgBox Nom & Chr(10) & "n'est pas présent dans la chaine " & Chr(10) & [G4]
    End If
End Sub

et utilisez plutot cette fonction :

Code:

Function Affichage(N)
' Attention! La référence "Microsoft Form 2.0 Object Library." doit être validée
    With New DataObject
        .GetFromClipboard
        Texte = .GetText(1)
    End With
    Texte = Replace(Texte, " ", "")
    Texte = Replace(Texte, Chr(10), "")
    Texte = Replace(Texte, Chr(13), "")
    If Left(Texte, 1) = "0" Then Texte = Mid(Texte, 2)
    Affichage = CStr(Texte)
End Function

Comme ça, ça marche aussi en copiant une cellule, je nettoie la chaine en supprimant les chr(10) chr(13) qui trainent.

Re-Sylvanu
J'ai un souci curieux :

Quand j'ouvre ton fichier, je vois bien la référence "référence Microsoft Form 2.0 Object Library" activée.
Chez moi sur office365, je ne la trouve pas.
Vraiment curieux...
Je cherche ...

sylvanu · 12 Octobre 2022

Re,
La référence Microsoft Form 2.0 Object Library devrait être présente, mais surement pas à la même place.
Si elle n'est pas cochée alors elles sont rangées par ordre alphabétiques.
Peut être une astuce glanée sur le net.
Si on fait un userform alors cette librairie est instanciée automatiquement. J'ai vérifié :
Avant la création d'un userform la librairie n'est pas présente :

Après la création d'un userform la librairie est présente :

Donc dans votre fichier, créer un userform, vérifier que la référence est valide, supprimer le userform, la référence reste validée.

job75 · 12 Octobre 2022

Bien entendu Lionel on peut utiliser ta macro Recherche, fichier (2) :

VB:

Sub Trouve()
Dim v, w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
Workbooks.Add 'nouveau document
ActiveSheet.Paste 'colle ce qui est dans le presse-papiers
v = Val(Replace([a1], " ", ""))
ActiveWorkbook.Close False
On Error GoTo 0
v = 33 & v
For Each w In Worksheets
    w.Cells.FormatConditions.Delete 'RAZ
    If v <> "330" Then
        w.UsedRange.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=" & v
        w.UsedRange.FormatConditions(1).Interior.ColorIndex = 44 'orange
    End If
Next
If v = "330" Then Exit Sub
CreateObject("wscript.shell").SendKeys v 'envoi de touches
Recherche 'lance la macro
End Sub

Usine à gaz · 12 Octobre 2022

Merci Gérard
Très bien, comme d'habitude.
J'aimerais juste que la mfc soit annulée après qu'il ait trouvé... Je pense pouvoir faire ça lol
Merci encore une fois

Microsoft 365 Coller directement mon N° cherché, APRES formatage dans "InputBox"

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

sylvanu

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Discussions similaires