Modifier paramètres objet Paint

[yannick64]

Bonsoir à tous,

Je cherche à intégrer dans une feuille excel une signature. Pour réussir j'ai essayé plusieurs méthodes et celle qui me parait la plus intéressante et d'utiliser "insertion objet - Bitmap" qui m'ouvre Paint.
Mon souci c'est que je n'arrive pas à définir la taille de mon image depuis Excel et quand je modifie les paramètres dans Paint ils ne sont pas sauvegardés pour la fois suivante.
Ma question est de savoir s'il y à un moyen de définir directement en VBA les caractéristiques dimensionnelle de ma zone de signature...

Voici le code que j'utilise :

ActiveSheet.OLEObjects.Add(ClassType:="Paint.Picture", Link:=False, _
        DisplayAsIcon:=False, Left:=340, Top:=30, Width:=350, Height:=155).Activate

Merci pour votre aide !
Yannick

 

[david84]

Re : Modifier paramètres objet Paint

Bonsoir,

@PMO2 : j'ai testé le fichier. Il faut modifier le BackColor du Frame et le mettre en blanc.
Concernant la compatibilité des API sous 64 bits :

#If Win64 Then
  Declare PtrSafe Function GetDC& Lib "user32.dll" ( _
    ByVal hWnd&)
  Declare PtrSafe Function ReleaseDC& Lib "user32.dll" ( _
    ByVal hWnd&, ByVal hdc&)
  Declare PtrSafe Function GetDeviceCaps& Lib "gdi32.dll" ( _
    ByVal hdc&, ByVal nIndex&)
  Declare PtrSafe Function LineTo& Lib "gdi32.dll" ( _
    ByVal hdc&, ByVal x&, ByVal y&)
  Declare PtrSafe Function MoveToEx& Lib "gdi32.dll" ( _
    ByVal hdc&, ByVal x&, ByVal y&, lpPoint As POINTAPI)
  '---
  Declare PtrSafe Sub keybd_event Lib "user32.dll" ( _
    ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags&, ByVal dwExtraInfo&)
  Declare PtrSafe Function CloseClipboard& Lib "User32" ()
  Declare PtrSafe Function OpenClipboard& Lib "User32" (ByVal hWnd&)
  Declare PtrSafe Function EmptyClipboard& Lib "User32" ()
  Declare PtrSafe Function SetActiveWindow& Lib "user32.dll" (ByVal hWnd&)
  '---
  Declare PtrSafe Function FindWindow& Lib "User32" Alias "FindWindowA" ( _
    ByVal lpClassName$, ByVal lpWindowName$)
  Declare PtrSafe Function SetWindowLong& Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
  Declare PtrSafe Function GetWindowLong& Lib "user32.dll" Alias "GetWindowLongA" ( _
    ByVal hWnd&, ByVal nIndex&)
#Else
  Declare Function GetDC& Lib "user32.dll" ( _
    ByVal hWnd&)
  Declare Function ReleaseDC& Lib "user32.dll" ( _
    ByVal hWnd&, ByVal hdc&)
  Declare Function GetDeviceCaps& Lib "gdi32.dll" ( _
    ByVal hdc&, ByVal nIndex&)
  Declare Function LineTo& Lib "gdi32.dll" ( _
    ByVal hdc&, ByVal x&, ByVal y&)
  Declare Function MoveToEx& Lib "gdi32.dll" ( _
    ByVal hdc&, ByVal x&, ByVal y&, lpPoint As POINTAPI)
  '---
  Declare Sub keybd_event Lib "user32.dll" ( _
    ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags&, ByVal dwExtraInfo&)
  Declare Function CloseClipboard& Lib "User32" ()
  Declare Function OpenClipboard& Lib "User32" (ByVal hWnd&)
  Declare Function EmptyClipboard& Lib "User32" ()
  Declare Function SetActiveWindow& Lib "user32.dll" (ByVal hWnd&)
  '---
  Declare Function FindWindow& Lib "User32" Alias "FindWindowA" ( _
    ByVal lpClassName$, ByVal lpWindowName$)
  Declare Function SetWindowLong& Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
  Declare Function GetWindowLong& Lib "user32.dll" Alias "GetWindowLongA" ( _
    ByVal hWnd&, ByVal nIndex&)
#End If

Pour moi c'est ok en version 32 bits avec Excel 2007 et 64 bits avec Excel 2010.

A+

 

[PMO2]

Re : Modifier paramètres objet Paint

@ david84
Merci beaucoup de m'éclairer sur le fonctionnement et d'indiquer les Declare en 64 bits.

 

[david84]

Re : Modifier paramètres objet Paint

Intéressant ton fichier...
une suggestion (mais bon à tester plus avant) : plutôt que

'--- Copie et colle la fenêtre active ---
keybd_event vbKeySnapshot, 1&, 0&, 0&
On Error Resume Next
Do
  Err.Clear
  DoEvents
  Sheets(1).Paste
Loop Until Err = 0
On Error GoTo 0

Peut-être quelque chose dans le genre :

'--- Copie et colle la fenêtre active ---
keybd_event vbKeySnapshot, 1&, 0&, 0&
DoEvents
Sheets(1).Cells(1, 1).Select
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_V, 0, 0, 0
keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
Sleep 100

Bien sûr ton code fonctionne mais peut-être est-il plus "sûr" de continuer dans l'utilisation de keybd_event plutôt que de placer une boucle Do Loop dans laquelle tu dois gérer l'erreur déclenchée par le fait de coller la copie d'écran.

Ne pas oublier dans le module des API

Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_CONTROL As Long = &H11
Public Const VK_V = 86

et l'ajout de Sleep

  Declare Sub Sleep Lib "kernel32" ( _
                 ByVal dwMilliseconds As Long)

ou pour le 64 bits

  Declare PtrSafe Sub Sleep Lib "kernel32" ( _
                 ByVal dwMilliseconds As Long)

Ou alors si tu préfère utiliser Paste, utiliser Sleep juste après DoEvents

keybd_event vbKeySnapshot, 1&, 0&, 0&
 DoEvents
 Sleep 100 'augmenter si nécessaire
 Sheets(1).Paste

Enfin bon c'est l'idée.
A+

 

[PMO2]

Re : Modifier paramètres objet Paint

@ david84

une suggestion (mais bon à tester plus avant)

Si cela fonctionne, pourquoi pas.

Cependant, il me semble avoir rencontré de fâcheux dysfonctionnements avec l'utilisation de Sleep.
Si l'application parent reprenait la main, il n'en était pas de même du processeur.
Je crois me souvenir que c'est ce qu'il s'était passé pour d'anciens cas que j'avais traités. Et j'avais contourné le problème avec un traitement d'erreur et l'emploi répété de l'instruction DoEvents qui oblige fortement le processeur à ce qu'il reprenne la main.

A voir donc !

 

[yannick64]

Re : Modifier paramètres objet Paint

Bonjour PM02,

J’étais en déplacement à l’étranger je n'ai donc pas pus répondre avant... C'est Excel 2007 et il n'existe qu'en 32 bits d'après le site Microsoft.

Quand je lance ce classeur et que j’exécute la macro j'ai une fenêtre noire qui apparait.

Il y a peut être un simple réglage à faire?

Yannick

 

[PMO2]

Re : Modifier paramètres objet Paint

Bonjour,

david84, dans son message #16, a fait la remarque

@PMO2 : j'ai testé le fichier. Il faut modifier le BackColor du Frame et le mettre en blanc.

Dans le code, apportez la modification signalée par '/// ajout du 05/12/2014

Private Sub UserForm_Initialize()
Const PointsParPouce As Long = 72  '1 Inch = 72 Points [Postscript] | 1 Point = 0.01388888889 Inch
'---
X_Coeff2Points# = PointsParPouce / GetDeviceCaps(GetDC(Application.hWnd), LOGPIXELSX)
Y_Coeff2Points# = PointsParPouce / GetDeviceCaps(GetDC(Application.hWnd), LOGPIXELSY)
ReleaseDC 0, myHdc&
myHdc& = GetDC(UserForm1.Frame1.[_GethWnd])

Me.Frame1.BackColor = vbWhite '/// ajout du 05/12/2014
End Sub

 

[yannick64]

Re : Modifier paramètres objet Paint

Merci à vous 2, je n'avais pas fait attention qu'il y avait eu d'autre messages en mon absence... Désolé

Ça marche !
Merci beaucoup !!!

Yannick

 

[yannick64]

Re : Modifier paramètres objet Paint

Encore une petite question, est il possible plutôt que de réduire le Userform à la taille de la Frame et de le coller ensuite de faire directement un copier coller de la frame elle même?

Merci
Yannick