ActiveSheet.OLEObjects.Add(ClassType:="Paint.Picture", Link:=False, _
DisplayAsIcon:=False, Left:=340, Top:=30, Width:=350, Height:=155).Activate
Sub aa()
Dim R As Range
Dim OL As OLEObject
'---
On Error GoTo Erreur
Set R = Application.InputBox(prompt:="Sélectionnez un cellule ou une plage. Le cadre signature viendra s'y intégrer", Type:=8)
'---
Set OL = ActiveSheet.OLEObjects.Add(ClassType:="Paint.Picture")
With OL
.Top = R.Top
.Left = R.Left
.Width = R.Width
.Height = R.Height
End With
'---
Erreur:
End Sub
**************
Par signature, tu entends quoi ?Je cherche à intégrer dans une feuille excel une signature.
Sub TestI()
Dim SignatureImgPath$
ImgPath$ = "C:\Users\Abc\Pictures\testpict.png"
ActiveSheet.Pictures.Insert ImgPath
End Sub
Sub TestII()
Dim Signature As Shape, ImgPath$
ImgPath$ = "C:\Users\Abc\Pictures\testpict.png"
Set Signature = ActiveSheet.Shapes.AddPicture(ImgPath, False, True, 0, 0, -1, -1)
'Avec le paramètre LinkToFile sur True l'image est liée -> cf l'URL ci-dessous
'Set Signature = ActiveSheet.Shapes.AddPicture(ImgPath, True, True, 0, 0, -1, -1)
End Sub
J'ai supprimé mon précédent message car il restait sans réaction et semblait n'intéresser personne.yannick64
Pourquoi avez vous supprimé votre message?
Je pense que c'est la 2 qui fait l'objet de la demande.Staple1600
2) une image modifiable à la volée ensuite insérée dans Excel
Private Sub CommandButton1_Click()
Frame1.Repaint
End Sub
Private Sub CommandButton2_Click()
'--- Réduit le UserForm à la taille de la Frame ---
Me.Width = Frame1.Width
Me.Height = Frame1.Height
'--- Libère le presse-papiers ---
OpenClipboard 0&
EmptyClipboard
CloseClipboard
'--- 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
'--- Décharge l'USF ---
Unload Me
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub Frame1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 1 Then SetDrawStart x, y
End Sub
Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 1 Then Draw x, y
End Sub
Private Sub UserForm_Activate()
Dim Hndl&
'--- Retire la barre titre de l'USF ---
Hndl& = FindWindow("Thunder" & IIf(Application.Version Like "8*", "0*", "D") & "Frame", UserForm1.Caption)
SetWindowLong Hndl&, -16, GetWindowLong(Hndl&, -16) And Not &HC00000
End Sub
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])
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ReleaseDC UserForm1.Frame1.[_GethWnd], myHdc&
End Sub
'### APIs ###
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&)
'### Constante et Type API ###
Public Const LOGPIXELSX As Long = 88 'Number of pixels per logical inch along the screen width
Public Const LOGPIXELSY As Long = 90 'Number of pixels per logical inch along the screen height
Type POINTAPI
x As Long
y As Long
End Type
'### Variables publiques ###
Public PositionMouse As POINTAPI
Public myHdc&
Public X_Coeff2Points#
Public Y_Coeff2Points#
Sub SetDrawStart(ByVal x As Long, ByVal y As Long)
MoveToEx myHdc&, x / X_Coeff2Points#, y / Y_Coeff2Points#, PositionMouse
End Sub
Sub Draw(ByVal x As Long, ByVal y As Long)
LineTo myHdc&, x / X_Coeff2Points#, y / Y_Coeff2Points#
End Sub