XL 2010 Compatibilité 32 - 64 bits

M

mécano41

XLDnaute Accro
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
 

Pièces jointes

  • 427370d1607615621-calcul-excel-levage-d-une-passerelle-mecano41.jpg
    427370d1607615621-calcul-excel-levage-d-une-passerelle-mecano41.jpg
    92.6 KB · Affichages: 83
Trier par date Trier par votes
M

mécano41

XLDnaute Accro
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
 

Pièces jointes

  • Ecran1.jpg
    Ecran1.jpg
    37.6 KB · Affichages: 28
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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]
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
#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)


1607759607196.png


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é
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
M

mécano41

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
M

mécano41

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

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
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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...
Cliquez pour agrandir...
a ben la il ne risque pas d'avoir les graph dans le userform
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
M

mécano41

XLDnaute Accro
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
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
XL 2019 Probleme olepro32 et/ou LongPtr
Réponses
11
Affichages
620
patricktoulon
patricktoulon
patricktoulon
  • Question
XL 2013 enregistrer la capture d'une shape avec les api avec transparence
2
Réponses
26
Affichages
852
patricktoulon
patricktoulon
cathodique
  • Résolu(e)
XL 2010 Utilisation API
2
Réponses
22
Affichages
659
patricktoulon
patricktoulon
E
  • Résolu(e)
Microsoft 365 32 ou 64 bits
2 3 4
Réponses
46
Affichages
2 K
eric72
E
riton00
  • Résolu(e)
XL 2021 Modification d'un code VBA
Réponses
5
Affichages
308
kiki29
kiki29
Y
  • Résolu(e)
Affichage Userform en plein écran quelque soit la taille de l'écran
2
Réponses
22
Affichages
847
youguybass
Y
patricktoulon
  • Question
Autres que penses vous de ce mini test benchmark(timer plus precis)
Réponses
6
Affichages
489
patricktoulon
patricktoulon
patricktoulon
  • Résolu(e)
XL 2013 prise de tête avec une variable static
Réponses
3
Affichages
354
patricktoulon
patricktoulon
V
  • Question
XL 2021 Upload fichier depuis Bureau
Réponses
7
Affichages
467
vmax67
V
R1-
  • Question
XL 2016 Impossible de SendKeys une tabulation
Réponses
4
Affichages
572
R1-
R1-

Membres actuellement en ligne

5 membres et 47 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 719
Messages
2 112 183
Membres
111 455
dernier inscrit
Jacandre