sauvegarde en .gif pour userform

[Temjeh]

Bonjour à tous et bravo encore pour ce site.

J'ai ceci qui fonctionne très bien pour la sauvegarde de plage en gif.

ChDir ThisWorkbook.Path
Dim i
i = InputBox(prompt:='Entrer le nom de la plage a sauvegardée ? ', Title:='New')
Dim R As Range
Application.ScreenUpdating = False
Set R = Selection
R.CopyPicture
ActiveSheet.Paste
Selection.Name = 'Temp'
With ActiveSheet.ChartObjects
With .Add(0, 0, Selection.Width, Selection.Height).Chart
.Paste
.Export i & '.gif', 'gif'
End With
.Delete
End With
ActiveSheet.Shapes('Temp').Delete
Application.ScreenUpdating = True

Y a t il un moyen de le modifié pour la sauvegarde en .gif pour mes userform. J'avais pensé ...Set R = Userform1 mais ...pas bon.


Merci beaucoup

A+

Temjeh

Merci

 

[MichelXld]

bonsoir Temjeh

j'espere que cet exemple pourra t'aider

Option Explicit

Private Declare Sub keybd_event Lib 'user32' ( _
ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)

Private Declare Function ShellExecute Lib 'shell32.dll' Alias 'ShellExecuteA' _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub CommandButton1_Click()
'test WinXP & Excel2002
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents

Application.ScreenUpdating = True
Range('A1').Select
ActiveSheet.Paste

Selection.Name = 'Temp'
With ActiveSheet.ChartObjects
With .Add(0, 0, Selection.Width, Selection.Height).Chart
.Paste
.Export 'C:\\\\\\\\monImage.gif', 'gif'
End With
.Delete
End With
ActiveSheet.Shapes('Temp').Delete
Application.ScreenUpdating = True

'-------------------------------------------------------------
'option pour les utilisateur de Windows XP :
'visualisation de l'image créée avec avec l'apercu images_telecopies Windows
'testé avec Excel2002 et WinXP

'ShellExecute 0, 'open', 'rundll32.exe', _
''C:\\\\\\\\WINDOWS\\\\\\\\System32\\\\\\\\shimgvw.dll,ImageView_Fullscreen ' & 'C:\\\\\\\\monImage.gif', 0, 1

End Sub


bon week end
MichelXld

 

[Temjeh]

Désolé je viens dîner et j'ai tester et c'est parfait!!

Merci beaucoup Michel c'est justement ca
Un peut plus de ligne que le code pour plage

A+

Temjeh