Microsoft 365 tester si valeur dans le presse-papier ou ClipBoard est numérique ou non

[Usine à gaz]

Bonjour à toutes et à tous,

je bloque sur mon besoin malgré mes recherches et tentatives.

Ce que je fais :
1 - copier d'une valeur,
2 - j'ai besoin de tester si cette valeur est numérique ou non pendant qu'elle est dans le presse-papier ou ClipBoard
ou quand elle est collé dans la recherche find car je ne la colle pas dans une cellule.

par exemple pour dire : Is Not Numeric() Then Exit Sub
je ne suis pas certain que cela soit possible mais si solution il y a, ça m'arrangerait bien LOl

Un grand merci , comme d'habitude, à toutes et à tous pour votre aide toujours si précieuse.
S'il est nécessaire de faire une fichier test, dites-moi
Je vous souhaite une super WE,
Amicalement,
lionel,

 

[Staple1600]

Bonjour le fil, arthour973

arthour973
Ton moteur de recherche est en panne...

Public Clipboard As New MSForms.DataObject
'NB/ Cocher référence : Ms Forms 2.0
Sub TestClipboard()
Dim DataObj As New MSForms.DataObject, vStr$
DataObj.GetFromClipboard
vStr = DataObj.GetText
MsgBox IsNumeric(vStr)
End Sub
Sub Test_A()
[A1] = 123
[A1].Copy
TestClipboard
Application.CutCopyMode = False
End Sub
Sub Test_B()
[A1] = "abcd"
[A1].Copy
TestClipboard
Application.CutCopyMode = False
End Sub

Testé sur XL2013

 

[Usine à gaz]

Bonjour JM,
Un grand merci à toi
J'avais cherché mais pas vu.
Je teste et je te dis
lionel,

 

[Usine à gaz]

Re-Bonjour JM, le forum,

Je suis sous Office 365 avec excel 2016.
Impossible de trouver dans VBA Project la référence Ms Forms 2.0
pourtant, j'ai bien le fichier FM20.DLL dans le dossier Système 32.

Et j'ai le message suivant :


Peux-tu m'aider ?

 

[Staple1600]

Re

Oui.
Toujours le même conseil
=> moteur de recherche

 

[Usine à gaz]

J'ai trouvé, il faut faire les actions suivantes :
dans l'éditeur VBA :
> références >Parcourir>le nom du fichier DLL > ouvrir et c'est tout bon

 

[Usine à gaz]

Re et Re,

J'ai bien activé la référence mais ça ne fonctionne pas et je ne comprends pas pkoi
Message d'erreur :


Je continue à chercher,
lionel,

 

[Staple1600]

Re

Problème liée sans doute à ta version d'Excel
Dans ce cas, il faut voir du côté des API

Envoyer des informations au Presse-papiers

Rubrique de référence sur Office VBA

docs.microsoft.com

 

[Staple1600]

Re

Donc à tester
(en ayant copié au préalable dans un module standard, le code présent dans le lien de mon précédent message)

Sub Test_AA()
[A1] = 123
[A1].Copy
MsgBox IsNumeric(GetClipboard)
End Sub

Sub Test_BB()
[A1] = "abc"
[A1].Copy
MsgBox IsNumeric(GetClipboard)
End Sub

NB: Si besoin utiliser PtrSafe pour les déclarations (en haut du module)

 

[Usine à gaz]

LOL, trop compliqué pour moi et je n'y arrive pas.
Je laisse tomber "l'affaire"
LOL

 

[Staple1600]

Re

arthour973
?
Où est le compliqué ?
Il suffit de faire un copié/collé...

NB: Tu es Barbatruc ou tu n'es pas Barbatruc !

 

[Usine à gaz]

LOL Barbatruc ne veut tjrs rien dire
mais je suis sur une autre piste toute simple et je pense que ce sera bon.

 

[Staple1600]

Re

Donc en gros, j'ai perdu mon temps ...

NB: Heureusement que d'autres liront ce fil et sauront faire un bête copier/coller dans un module standard.

 

[Staple1600]

Re

Donc pour ceux qui oseront faire CTRL+C puis CTRL+V

Spoiler: compliqué ou poil dans la main? ;-)

Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long

Public Sub SetClipboard(sUniText As String)
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Dim sUniText As String
    Const CF_UNICODETEXT As Long = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If
    CloseClipboard
End Function
Sub Test_AA()
[A1] = 12345
[A1].Copy
MsgBox IsNumeric(GetClipboard)
End Sub

Sub Test_BB()
[A1] = "C'était vraiment compliqué LOL"
[A1].Copy
MsgBox IsNumeric(GetClipboard)
End Sub

 

[mapomme]

Bonjour @arthour973 , @Staple1600 ,

Staple1600 a tout fait . Comme j’avais commencé, je publie.