Convertir un usf en photo jpeg

[BLACKHAYES]

re-bonjour le forum,

Quel est le code pour transformer un usf en photo jpeg et l'enregistrer sur le bureau

 

[Papou-net]

Re : Convertir un usf en photo jpeg

re-bonjour le forum,

Quel est le code pour transformer un usf en photo jpeg et l'enregistrer sur le bureau

Bonsoir BLACKHAYES,

Le code, je ne connais pas, par contre, j'ai une solution manuelle :

Lancer le UserForm, appuyer sur ALT & Impr, puis fermer le formulaire. Ensuite, ouvrir un logiciel d'édition d'images (Paint pour ne pas en citer d'autres, coller le presse-papier et sauvegarder en .jpg. Mais peut-être connaissais-tu déjà cette manière de faire ?

Espérant avoir été utile.

Cordialement.

 

[BLACKHAYES]

Re : Convertir un usf en photo jpeg

ok, oui je connais cette solution, maismoi je veux, une solution par macro sur un bouton

merci quand meme

cordialement

 

[kiki29]

Salut,pas en jpg mais bmp

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 OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As String, ByRef lpiid As GUID) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" (pPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef ppvObj As IPicture) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(8) As Byte
End Type

Private Type PICTDESC
    cbSize As Long
    picType As Long
    hImage As Long
End Type

Private iPic As IPicture
Private mode As Long

Sub SnapShot_USF_BMP()
Dim tIID As GUID, tPICTDEST As PICTDESC, Ret As Long
Dim hCopy As Long
Const IPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

    keybd_event vbKeySnapshot, 1, 0&, 0&
    DoEvents

    OpenClipboard 0&

    hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H8)
    CloseClipboard
    If hCopy = 0 Then Exit Sub

    Ret = IIDFromString(StrConv(IPictureIID, vbUnicode), tIID)
    If Ret Then Exit Sub
    With tPICTDEST
        .cbSize = Len(tPICTDEST)
        .picType = 1
        .hImage = hCopy
    End With
    Ret = OleCreatePictureIndirect(tPICTDEST, tIID, 1, iPic)
    If Ret Then Exit Sub

    SavePicture iPic, ThisWorkbook.Path & "\" & "USF.bmp"
    Set iPic = Nothing
End Sub

 

[BLACKHAYES]

Re : Convertir un usf en photo jpeg

Merci KIKI29, Maisje ne sais pasou placer ce codeet quand je le plasse dans un bouton qui est sur mon usf il me met en erreur.

 

[kiki29]

Salut,le code dans un Module standard et un bouton sur l'UserForm affecté à la procédure SnapShot_USF_BMP

 

[BLACKHAYES]

Re : Convertir un usf en photo jpeg

et comment fait on pour affecté la procedure Snapshot_uSF_bmp a un bouton ????

 

[kiki29]

Re,Double Clic sur le Bouton en question ou Clic Droit puis dans le menu contextuel Code
cela génère le code suivant

Private Sub CommandButton2_Click()

End Sub

puis insérer SnapShot_USF_BMP

Private Sub CommandButton2_Click()
    SnapShot_USF_BMP
End Sub

 

[BLACKHAYES]

Re : Re: Convertir un usf en photo jpeg

génial ca fonctionne super

merci a toi et en plus c'est super rapide

 

[Lanetmel]

Re : Re: Convertir un usf en photo jpeg

Bonjour
Cette discussion et la solution de KiKi29 m'ont beaucoup aidé. Cependant j'aimerais modifier 3 choses et j'aurais besoin d'un coup de main..
1ère chose : J'aimerais enlever certains items de mon usf avant de le transférer.
ex :
commandButton1. visible= false
commandButton2. visible= false
Je ne sais pas ou mettre ce code dans le code donné par KiKi :
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 OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As String, ByRef lpiid As GUID) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" (pPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef ppvObj As IPicture) As Long

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(8) As Byte
End Type

Private Type PICTDESC
cbSize As Long
picType As Long
hImage As Long
End Type

Private iPic As IPicture
Private mode As Long

Sub SnapShot_USF_BMP()
Dim tIID As GUID, tPICTDEST As PICTDESC, Ret As Long
Dim hCopy As Long
Const IPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents

OpenClipboard 0&

hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H8)
CloseClipboard
If hCopy = 0 Then Exit Sub

Ret = IIDFromString(StrConv(IPictureIID, vbUnicode), tIID)
If Ret Then Exit Sub
With tPICTDEST
.cbSize = Len(tPICTDEST)
.picType = 1
.hImage = hCopy
End With
Ret = OleCreatePictureIndirect(tPICTDEST, tIID, 1, iPic)
If Ret Then Exit Sub

SavePicture iPic, ThisWorkbook.Path & "\" & "USF.bmp"
Set iPic = Nothing
End Sub

2ème chose : J'aimerais que le nom du fichier soit "Bon de Commande" (à la place de USF) ça je sais faire mais j'aimerais que la valeur de ma Texbox4 soit aussi dans le nom
ça donnerais ex : Bon De Commande 2217 (le numéro augmente de 1 chaque fois que le usf est fermé)
et finalement la 3ème chose est que je voudrais qu'à la suite de tout ceci en appuyant sur le même bouton qui créer le fichier .bmp, un courriel s'envoi avec l'adresse courriel contenue dans la Combobox6 avec le fichier .bmp créer

Tout cela est-il possible?
Quelqu'un peu m'aider?
merci à l'avance!