XL 2010 Compatibilité 32 - 64 bits

mécano41 · 10 Décembre 2020

Bonjour,

J'ai récupéré ce code qui a bien fonctionné jusqu'à présent. Mon ordi est en 64 bits mais ma version EXCEL (2010) est en 32 bits. Je viens de passer à quelqu'un un fichier contenant ce code, et il a le problème indiqué ci-dessous. Que puis-je modifier pour faire une seconde fonction qui fonctionne en 64 bits? Ensuite, comment faire pour que l'appli. choisisse entre les deux fonction?

(tout ceci sachant que je ne pourrai pas faire les essais en 64 bits moi-même)

Si nécessaire, je pourrai poster l'appli...

Cordialement

Le code complet :

Code:

Option Explicit

'-============= Code récupéré sur ExcelDownloads ============
' 14/11/2012
' myDearFriend!  -   www.mdf-xlpages.com
'---------------------------------------------------------------------------------------
'!* MODULE NAME:     Paste Picture
'!* AUTHOR & DATE:   STEPHEN BULLEN, Business Modelling Solutions Ltd.
'!*                  15 November 1998
'!* CONTACT:         Stephen@BMSLtd.co.uk
'!* WEB SITE:        http://www.BMSLtd.co.uk
'
'! un peu modifié par Thierry Pourtier (Ti) oct 2004
'---------------------------------------------------------------------------------------
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

' -----
Private Type uPicDesc
  Size As Long
  Type As Long
  hPic As Long
  hPal As Long
End Type

' -----
Private Declare Function IsClipboardFormatAvailable& Lib "user32" (ByVal wFormat&)
Private Declare Function OpenClipboard& Lib "user32" (ByVal hWnd&)
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, IPic As IPicture)
Private Declare Function CopyEnhMetaFile& Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc&, ByVal lpszFile$)
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)

Const CF_BITMAP = 2, CF_PALETTE = 9, CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0, LR_COPYRETURNORG = &H4
Const PICTYPE_BITMAP = 1, PICTYPE_ENHMETAFILE = 4

' -----
Private Function CreatePicture(hPic&, hPal&, lPicType&) As IPicture
Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture
  With IID_IDispatch
    .Data1 = &H7BF80980
    .Data2 = &HBF32
    .Data3 = &H101A
    .Data4(0) = &H8B
    .Data4(1) = &HBB
    .Data4(2) = &H0
    .Data4(3) = &HAA
    .Data4(4) = &H0
    .Data4(5) = &H30
    .Data4(6) = &HC
    .Data4(7) = &HAB
  End With
  With uPicInfo
    .Size = Len(uPicInfo)
    .Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)
    .hPic = hPic
    .hPal = IIf(lPicType = CF_BITMAP, hPal, 0)
  End With
  OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
  Set CreatePicture = IPic
End Function

' -----
Function PastePicture(Optional lXlPicType& = xlPicture) As IPicture
Dim hPtr&, lPicType&, hCopy&
  lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)
  
  If IsClipboardFormatAvailable(lPicType) Then
    If OpenClipboard(0&) > 0 Then
      hPtr = GetClipboardData(lPicType)
      If lPicType = CF_BITMAP Then
        hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
      Else
        hCopy = CopyEnhMetaFile(hPtr, vbNullString)
      End If
      CloseClipboard
      If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
    End If
  End If
End Function

mécano41 · 12 Décembre 2020

Bonjour,

Je suis bien en Win64 et en Office32 mais, comme indiqué dans l'intitulé du premier message, en version 2010 et, d'après ce que je viens de lire à plusieurs endroits, c'est en VBA7. Un test me le confirme.

Et cela ne me dit pas pourquoi si, pour Windows, j'écris ce test :

Code:

#If Win64 Then
    Public Const res As String = "Win64"
#End If
'
Sub test2()
MsgBox res   'Affiche la version Win
End Sub

il me donne un message vide et si je remplace Win64 par Win32 il m'affiche une réponse...

EDIT : ce n'est pas chez moi qu'il y a un problème avec ce code mais chez mon correspondant auquel j'avais envoyé le fichier de l'appli. du message #4 et qui m'a envoyé la copie d'écran que tu as pu voir au message #1.

Cordialement

Staple1600 · 12 Décembre 2020

Bonjour le fil

[Pour infos -entre deux tartines beurrées et confiturées]
Aversion pour la version?
Chacun sa version 😉

VB:

Sub DelaVersionEnVeuxTuEnVoila()
MsgBox Application.VBE.version 'Version VBA
MsgBox Application.CalculationVersion
MsgBox Application.OperatingSystem
MsgBox Application.version
End Sub

[/Pour infos -entre deux tartines beurrées et confiturées]

patricktoulon · 12 Décembre 2020

#if win64 est déclenche uniquement si excel est en 64
d’ailleurs les test de Staple1600 vont te le confirmer
comme tu peux le voir mon windows est un 32 alors q'en vérité c'est un 64
c'est pas pour rien qu'il y a un system32 et un sywow
de cela dépend la méthode a utiliser (pour les api)

VB:

Sub DelaVersionEnVeuxTuEnVoila()
t = Application.VBE.Version & vbCrLf 'Version VBA
t = t & Application.CalculationVersion & vbCrLf
t = t & Application.OperatingSystem & vbCrLf
t = t & Application.Version & vbCrLf
MsgBox t
End Sub

attention pour la ligne(t=application vbe........) il faut que l’accès approuvé au project soit activé

Staple1600 · 12 Décembre 2020

Re, Bonjour patricktoulon

Tant qu'on y est mettons de l'Array et de l'endive
(mais pas de l'endive dans la ... 😉)

VB:

Sub De_la_VersionEnVeuxTuEnVoila_Et_En_Revoici()
Dim a(4), v$
With Application
    a(0) = .VBE.version: a(1) = .CalculationVersion
    a(2) = .OperatingSystem: a(3) = .version
End With
v = Join(a, vbCrLf)
MsgBox v
End Sub

patricktoulon · 12 Décembre 2020

c'est bon les endive

Staple1600 · 12 Décembre 2020

Certes

[éloignez les enfants]
Mais les endives dans la raie, pardon l'array, c'est moins bon
quoique 😉
[/éloignez les enfants]

mécano41 · 12 Décembre 2020

Bonjour à tous,

Merci pour ces réponses. Je commence à mieux comprendre le pourquoi des résultats a priori bizarres...

Je vais voir ce que je peux en tirer mais je ne pense pas que ce sera dans cette appli. car il y a un autre problème : j'ai des ActiveX sur la feuille et j'ai lu qu'il n'y avait pas de solution simple...tant pis.

Merci encore,

Cordialement

patricktoulon · 12 Décembre 2020

bonjour
si tu nous donnais un fichier sans données confidentielles
chacun pourrait tester sur les versions appropriée

mécano41 · 12 Décembre 2020

patricktoulon à dit:
bonjour
si tu nous donnais un fichier sans données confidentielles
chacun pourrait tester sur les versions appropriée

Mais tu l'as depuis jeudi soir, dans le message #4...

Edit : pour info., mon correspondant vient d'ouvrir ce fichier mais dans lequel j'ai supprimé le module PastePicture et son utilisation, il me dit que cela a l'air de fonctionner...je ne comprends pas puisque les ActivX ne devraient pas...

Cordialement

patricktoulon · 12 Décembre 2020

ok d'accords si je comprend bien tu copie tes graph en image dans le userform et sça s'arrete là
on est d'accords?

Edit : pour info., mon correspondant vient d'ouvrir ce fichier mais dans lequel j'ai supprimé le module PastePicture et son utilisation, il me dit que cela a l'air de fonctionner...je ne comprends pas puisque les ActivX ne devraient pas...

a ben la il ne risque pas d'avoir les graph dans le userform

patricktoulon · 12 Décembre 2020

re

VB:

Option Explicit

'-============= Code récupéré sur ExcelDownloads ============
' 14/11/2012
' myDearFriend!  -   www.mdf-xlpages.com
'---------------------------------------------------------------------------------------
'!* MODULE NAME:     Paste Picture
'!* AUTHOR & DATE:   STEPHEN BULLEN, Business Modelling Solutions Ltd.
'!*                  15 November 1998
'!* CONTACT:         Stephen@BMSLtd.co.uk
'!* WEB SITE:        http://www.BMSLtd.co.uk
'
'! un peu modifié par Thierry Pourtier (Ti) oct 2004
'---------------------------------------------------------------------------------------

' -----

' -----
#If Win64 Then
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As LongPtr
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As Long
    Declare PtrSafe Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As LongPtr, ByVal lpszFile As String) As LongPtr
    Declare PtrSafe Function CopyImage Lib "user32" (ByVal Handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
Private Type uPicDesc: Size As Long: Type As Long: hPic As LongPtr: hPal As LongPtr: End Type

#Else

    Private Declare Function IsClipboardFormatAvailable& Lib "user32" (ByVal wFormat&)
    Private Declare Function OpenClipboard& Lib "user32" (ByVal hWnd&)
    Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
    Private Declare Function CloseClipboard& Lib "user32" ()
    Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, IPic As IPicture)
    Private Declare Function CopyEnhMetaFile& Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc&, ByVal lpszFile$)
    Private Declare Function CopyImage& Lib "user32" (ByVal Handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
Private Type uPicDesc: Size As Long: Type As Long: hPic As Long: hPal As Long: End Type
#End If
Private Type GUID: Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(0 To 7) As Byte: End Type
Const CF_BITMAP = 2, CF_PALETTE = 9, CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0, LR_COPYRETURNORG = &H4
Const PICTYPE_BITMAP = 1, PICTYPE_ENHMETAFILE = 4

' -----
Private Function CreatePicture(hPic&, hPal&, lPicType&) As IPicture
    Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    With uPicInfo
        .Size = Len(uPicInfo)
        .Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)
        .hPic = hPic
        .hPal = IIf(lPicType = CF_BITMAP, hPal, 0)
    End With
    OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
    Set CreatePicture = IPic
End Function

' -----
Function PastePicture(Optional lXlPicType& = xlPicture) As IPicture
    Dim hPtr&, lPicType&, hCopy&
    lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)

    If IsClipboardFormatAvailable(lPicType) Then
        If OpenClipboard(0&) > 0 Then
            hPtr = GetClipboardData(lPicType)
            If lPicType = CF_BITMAP Then
                hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
            Else
                hCopy = CopyEnhMetaFile(hPtr, vbNullString)
            End If
            CloseClipboard
            If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
        End If
    End If
End Function

mécano41 · 12 Décembre 2020

Oui, c'est cela. Ce sont juste des images en .jpeg qui sont dans une feuille spécifique (je ne voulais pas de dessins dans un autre fichier)

Maintenant que mon correpondant m'a dit que les ActiveX fonctionnent, je vais essayer de mettre la détection des versions, passer les Long en LongPtr et mettre le PtrSafe dans les déclarations et voir si ça fonctionne chez lui...

Edit : merci, je viens de voir que tu m'as fait le boulot...

Je vous tiens tous au courant de la suite. Merci.

Cordialement

mécano41 · 12 Décembre 2020

Chez moi, ton code fonctionne parfaitement mais chez mon correspondant, on a l'erreur suivante.

Cordialement

patricktoulon · 12 Décembre 2020

essai
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
mais je doute car c'est un handle image que l'on repeche dans le clipboard

sinon peut être a t il l’accès au clipboard bloqué

Staple1600 · 12 Décembre 2020

Bonsoir le fil

C'est un problème connu 😉

Windows 7 (64 bit) Clipboard won't work between programs

I'm working with publisher and word and program called Snag-It for photo editing. I need ot copy images from Snag-It and paste into publisher. Sometimes it works but most of the time it doesn't. If I

answers.microsoft.com

Effectuez une recherche sur Excel Downloads...

XL 2010 Compatibilité 32 - 64 bits

mécano41

XLDnaute Accro

Pièces jointes

mécano41

XLDnaute Accro

Pièces jointes

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mécano41

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

mécano41

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

mécano41

XLDnaute Accro

mécano41

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Windows 7 (64 bit) Clipboard won't work between programs

Discussions similaires

Nous accordons de l'importance à votre vie privée