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

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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,
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, arthour973

arthour973
Ton moteur de recherche est en panne... :rolleyes:
VB:
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

XLDnaute Barbatruc
Supporter XLD
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 :
Sans titre.jpg

Peux-tu m'aider ?
:)
 

Staple1600

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

Staple1600

XLDnaute Barbatruc
Re

Donc pour ceux qui oseront faire CTRL+C puis CTRL+V
VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 782
Membres
101 817
dernier inscrit
carvajal