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

Usine à gaz

XLDnaute Barbatruc
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 :)
 

Pièces jointes

  • copie n°_test.xlsm
    33 KB · Affichages: 4
Dernière édition:
Solution
Re,
Effectivement, c'est dimensionnant. :oops:

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.

sylvanu

XLDnaute Barbatruc
Supporter XLD
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 )
 

Pièces jointes

  • copie n°_test (1).xlsm
    33.3 KB · Affichages: 1

Usine à gaz

XLDnaute Barbatruc
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 :
1665569927912.png

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

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Effectivement, c'est dimensionnant. :oops:

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.
 

Pièces jointes

  • copie n°_test (V3).xlsm
    31.8 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

Pièces jointes

  • copie n°_test (V4).xlsm
    33.5 KB · Affichages: 2

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • copie n°_test(1).xlsm
    25.4 KB · Affichages: 2

Usine à gaz

XLDnaute Barbatruc
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 :
1665592142072.png

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...:rolleyes:
Je cherche ...
:)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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 :
1665590602692.png

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

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

XLDnaute Barbatruc
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
 

Pièces jointes

  • copie n°_test(2).xlsm
    30.3 KB · Affichages: 4

Discussions similaires

Réponses
26
Affichages
619
Réponses
10
Affichages
482

Statistiques des forums

Discussions
313 330
Messages
2 097 239
Membres
106 883
dernier inscrit
Papalo