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.

job75

XLDnaute Barbatruc
Plutôt que ta macro il est plus simple d'utiliser la boîte de dialogue Rechercher (Ctrl+F), fichier (3) :

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
Application.ScreenUpdating = True
If v <> "330" Then CreateObject("wscript.shell").SendKeys "^f" & v 'envoi de touches sur la boîte de dialogue Rechercher
End Sub
 

Pièces jointes

  • copie n°_test(3).xlsm
    26.1 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour Lionel, le forum,

Fichier (4) avec un UserForm et une ListBox :
VB:
Sub Trouve()
Dim v, w As Worksheet, c As Range
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
        For Each c In w.UsedRange
            If CStr(c) = v Then UserForm1.ListBox1.AddItem w.Name & "!" & c.Address(0, 0)
        Next c
    End If
Next w
Application.ScreenUpdating = True
If v <> "330" Then UserForm1.Show 0 'non modal
End Sub
VB:
Private Sub ListBox1_Click()
Application.Goto Range(ListBox1)
End Sub
A+
 

Pièces jointes

  • copie n°_test(4).xlsm
    29.1 KB · Affichages: 3

Discussions similaires

Réponses
26
Affichages
613
Réponses
10
Affichages
476

Statistiques des forums

Discussions
313 260
Messages
2 096 638
Membres
106 694
dernier inscrit
hussor.t