Modifier paramètres objet Paint

yannick64 · 18 Novembre 2014

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 :

Code:

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 · 1 Décembre 2014

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 :

Code:

#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 · 1 Décembre 2014

Re : Modifier paramètres objet Paint

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

david84 · 1 Décembre 2014

Re : Modifier paramètres objet Paint

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

Code:

'--- 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 :

Code:

'--- 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

Code:

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

et l'ajout de Sleep

Code:

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

ou pour le 64 bits

Code:

  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

Code:

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 · 1 Décembre 2014

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 · 5 Décembre 2014

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 · 5 Décembre 2014

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

Code:

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 · 5 Décembre 2014

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 · 5 Décembre 2014

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

Modifier paramètres objet Paint

yannick64

XLDnaute Junior

david84

XLDnaute Barbatruc

PMO2

XLDnaute Accro

david84

XLDnaute Barbatruc

PMO2

XLDnaute Accro

yannick64

XLDnaute Junior

Pièces jointes

PMO2

XLDnaute Accro

yannick64

XLDnaute Junior

yannick64

XLDnaute Junior

Discussions similaires

Modifier paramètres objet Paint

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Junior

Pièces jointes

XLDnaute Accro

XLDnaute Junior

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency