'### Constantes à adapter ###
Const PLAGE_PHOTO As String = "C3:H24"
Const CHEMIN As String = "C:\"
Const NOM_FICHIER As String = "Mon image"
Const SUFFIXE As String = ".jpg"
'############################
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos& Lib "user32" (ByVal x As Long, ByVal y As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
'##########################################################
'### Ne pas de lancer le programme à partir du VBE ###
'### si la fenêtre Excel n'est pas visible ###
'### à cause des simulations clic gauche souris ###
'### Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) ###
'### Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) ###
'##########################################################
Sub PhotoMultiImages()
Dim R As Range
Dim CB As CommandBar
Dim CBB As CommandBarButton
Dim CO As ChartObject
Dim A$
Dim i&
Set R = ActiveSheet.Range(PLAGE_PHOTO)
R.Select
Set CB = CommandBars.Add
Set CBB = CB.Controls.Add(msoControlButton, ID:=280)
CBB.Execute
Set CBB = Nothing
CB.Delete
Set CB = Nothing
Call SetCursorPos(750, 750)
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
DoEvents 'ajout 5/01/2011
Selection.Copy
Selection.Cut
With R
Set CO = ActiveSheet.ChartObjects.Add(.Left, .Top, .Width, .Height)
End With
Do
i& = i& + 1
A$ = CHEMIN & NOM_FICHIER & i& & SUFFIXE
Loop Until Dir(A$) = ""
With CO.Chart
.Paste
.Export Filename:=A$
End With
CO.Cut
Set CO = Nothing
Set R = Nothing
End Sub