Discussion: Fonctionnement curieux macro [Toutes versions]

  1. #1
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    8 075
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 8 075
    Points : 14 182
    Points
    14 182

    Par défaut Fonctionnement curieux macro

    Bonjour à tous,

    J'utilise ce code pour remplir le presse-papiers sans le comprendre (je l'ai seulement copié) :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    'Handle 64-bit and 32-bit Office
    #If VBA7 Then
      Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
      Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
      Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, _
        ByVal dwBytes As LongPtr) As Long
      Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
      Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
      Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
      Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
        ByVal lpString2 As Any) As LongPtr
      Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
        As LongPtr, ByVal hMem As LongPtr) As Long
    #Else
      Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
      Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
      Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
        ByVal dwBytes As Long) As Long
      Declare Function CloseClipboard Lib "User32" () As Long
      Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
      Declare Function EmptyClipboard Lib "User32" () As Long
      Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
        ByVal lpString2 As Any) As Long
      Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
        As Long, ByVal hMem As Long) As Long
    #End If
     
    Public Const GHND = &H42
    Public Const CF_TEXT = 1
    Public Const MAXSIZE = 4096
     
    Function ClipBoard_SetData(MyString As String)
    'PURPOSE: API function to copy text to clipboard
    'SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx
     
    Dim hGlobalMemory As Long, lpGlobalMemory As Long
    Dim hClipMemory As Long, X As Long
     
    'Allocate moveable global memory
      hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
     
    'Lock the block to get a far pointer to this memory.
      lpGlobalMemory = GlobalLock(hGlobalMemory)
     
    'Copy the string to this global memory.
      lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
     
    'Unlock the memory.
      If GlobalUnlock(hGlobalMemory) <> 0 Then
        MsgBox "Could not unlock memory location. Copy aborted."
        GoTo OutOfHere2
      End If
     
    'Open the Clipboard to copy data to.
      If OpenClipboard(0&) = 0 Then
        MsgBox "Could not open the Clipboard. Copy aborted."
        Exit Function
      End If
     
    'Clear the Clipboard.
      X = EmptyClipboard()
     
    'Copy the data to the Clipboard.
      hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
     
    OutOfHere2:
      If CloseClipboard() = 0 Then
        MsgBox "Could not close Clipboard."
      End If
     
    End Function
     
    Sub CopyTextToClipboard()
    'PURPOSE: Copy a given text to the clipboard (using Windows API)
    'SOURCE: www.TheSpreadsheetGuru.com
    'NOTES: Must have above API declaration and ClipBoard_SetData function in your code
     
    Dim Txt As String
     
    'Put some text inside a string variable
      Txt = "This was copied to the clipboard using VBA!"
     
    'Place text into the Clipboard
       ClipBoard_SetData Txt
     
     
    End Sub
    Il fonctionne sans problème sur mon Excel 2016 32 bits - Windows 10 64 bits. J'ai un utilisateur pour lequel la ligne :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
    renvoie l'erreur :

    "Erreur de compilation : Incompatibilité de type".

    Merci d'avance à celui qui me dépannera.
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  2. #2
    Membre expert
    Avatar de dysorthographie
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    septembre 2016
    Messages
    2 307
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Charente Maritime (Poitou Charente)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels
    Secteur : Industrie

    Informations forums :
    Inscription : septembre 2016
    Messages : 2 307
    Points : 3 949
    Points
    3 949
    Billets dans le blog
    1

    Par défaut

    Bonjour Daniel,


    Code avec Patrick on ce demandait si ça fonctionnait sur 64Bits! : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    Const DATAOBJECT_BINDING AsString = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
    Public Property Let PressePapier(Value)
        With CreateObject(DATAOBJECT_BINDING)
            .SetText Value
            .PutInClipboard
        End With
    End Property
     
     
    Public Property Get PressePapier()
        With CreateObject(DATAOBJECT_BINDING)
            .GetFromClipboard
            PressePapier = .GetText
        End With
    End Property
     
     
    Private Sub test()
    PressePapier = "toto"
    Debug.Print PressePapier EndSub

    https://msdn.microsoft.com/en-us/lib...ffice.14).aspx

    Type Item Description
    Qualifier PtrSafe Indicates that the Declare statement is compatible with 64-bits. This attribute is mandatory on 64-bit systems.
    Data Type LongPtr A variable data type which is a 4-bytes data type on 32-bit versions and an 8-byte data type on 64-bit versions of Office 2010. This is the recommended way of declaring a pointer or a handle for new code but also for legacy code if it has to run in the 64-bit version of Office 2010. It is only supported in the VBA 7 runtime on 32-bit and 64-bit. Note that you can assign numeric values to it but not numeric types.
    Data Type LongLong This is an 8-byte data type which is available only in 64-bit versions of Office 2010. You can assign numeric values but not numeric types (to avoid truncation).
    Conversion Operator CLngPtr Converts a simple expression to a LongPtr data type.
    Conversion Operator CLngLng Converts a simple expression to a LongLong data type.
    Function VarPtr Variant converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).
    Function ObjPtr Object converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).
    Function StrPtr String converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).
    Il dit non avec la tête
    mais il dit oui avec le coeur
    il dit oui à ce qu’il aime
    il dit non au professeur {Jacques PRÉVERT}

  3. #3
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    8 075
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 8 075
    Points : 14 182
    Points
    14 182

    Par défaut

    Bonjour et merci.

    Pour moi, c'est de l'hébreu... Je teste, j'envoie à mon utilisateur et je vous fais retour dès que j'ai la réponse.

    Cordialement.

    Daniel
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  4. #4
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    10 670
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 10 670
    Points : 16 991
    Points
    16 991
    Billets dans le blog
    1

    Par défaut re

    re
    et le meme avec lobject htmlfile mon préféré
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Public Property Let PressePapier(Value)
        With CreateObject("htmlfile")
              r = .parentwindow.clipboardData.setData("Text", Value)  
             End With
    End Property
     
    Public Property Get PressePapier()
        With CreateObject("htmlfile")
            PressePapier = .parentwindow.clipboardData.GetData("TEXT")
         End With
    End Property
    sub de teste

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Private Sub test()
    PressePapier = "toto"
    Debug.Print PressePapier
    End Sub
    autre sub de test

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Private Sub test2()
    Range("A1:b3").Copy
    MsgBox Replace(PressePapier, vbTab, " ")
    End Sub
    c'é bo la vie non?
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  5. #5
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    8 075
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 8 075
    Points : 14 182
    Points
    14 182

    Par défaut

    c'é bo la vie non?
    Je te dis ça demain.

    Cordialement.

    Daniel
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  6. #6
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    8 075
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 8 075
    Points : 14 182
    Points
    14 182

    Par défaut

    Bonjour à tous,

    @ dysorthographie : Merci pour le code. Je le teste dès que possible.
    Merci Patrick, le code fonctionne ici. Il reste à le tester chez l'utilisateur. Si j'avais encore des problèmes, je reviendrais vers toi.

    Cordialement.

    Daniel
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  7. #7
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    10 670
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 10 670
    Points : 16 991
    Points
    16 991
    Billets dans le blog
    1

    Par défaut re

    re
    Bonjour Daniel
    pas de soucis
    pour ma part je l'ai testé de 2007 a 2016 et ca fonctionne en 32/64 bits
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  8. #8
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    8 075
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 8 075
    Points : 14 182
    Points
    14 182

    Par défaut

    Ta solution a débloqué mes utilisateurs. Je vous transmets (à toi et à dysorthographie) mes remerciements et ceux de mes utilisateurs.

    Bonne fin de journée.

    Daniel
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  9. #9
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    10 670
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 10 670
    Points : 16 991
    Points
    16 991
    Billets dans le blog
    1

    Par défaut re

    re
    de rien
    je testerait egalement avec l'objectdata sur toute les versions
    pour info
    il y avait une contrib qui n'etait pas a proprement parler sur ton sujet mais dans la quelle tu aurait trouvé certainement ton bonheur
    https://www.developpez.net/forums/d1...s-differentes/
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Améliorer et faire fonctionner une macro !
    Par laurent481826 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 26/01/2015, 17h08
  2. Comment faire fonctionner une macro à une heure precise
    Par dreloman dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 29/06/2008, 01h46
  3. Fonctionnement de macro.
    Par Julieta dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 15/11/2007, 11h23
  4. Fonctionnement Curieux d'un TForm
    Par SER dans le forum Delphi
    Réponses: 1
    Dernier message: 11/05/2007, 11h39
  5. comment faire fonctionner les macros d'un modèle Word (.dot)?
    Par chtibreizh62 dans le forum VBA Word
    Réponses: 2
    Dernier message: 18/12/2006, 15h18

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo