1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
| Public Function PrendrePhoto(posLeft As Integer, posTop As Integer, width As Integer, height As Integer, nomFic As String)
Dim RetVal
' Make sure the current directory is set to the one
' where the Excel file is saved
ChDir (ActiveWorkbook.Path)
If Dir(nomFic + ".bmp") > "" Then
' Suppression de la dernière image
Kill (nomFic + ".bmp")
End If
If Dir(nomFic + ".jpg") > "" Then
Kill (nomFic + ".jpg")
End If
' Capture new image
RetVal = Shell("CommandCam.exe /preview /delay 2000 /filename " + nomFic + ".bmp", vbHide)
' Wait until image file is definitely there
While Dir(nomFic + ".bmp") = ""
Wend
' Short delay to let new file finish saving
Application.Wait (Now + TimeValue("00:00:01"))
' Conversion de l'image en JPG
' RetVal = Shell("imagemagick/convert.exe " + nomFic + ".bmp " + nomFic + ".jpg", vbHide)
RetVal = Shell("BMP2JPG.exe " + nomFic + ".bmp " + nomFic + ".jpg", vbHide)
While Dir(nomFic + ".jpg") = ""
Wend
' Load new image into image object on spreadsheet
' Image1.Picture = LoadPicture("image.bmp")
' Insertion de l'image avec un lien externe
' ActiveSheet.Pictures.Insert(nomFic + ".bmp").Select
' Insertion de l'image embarquée dans le document
ActiveSheet.Shapes.AddPicture Filename:=nomFic + ".jpg", linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=posLeft, Top:=posTop, width:=width, height:=height
End Function |
Partager