Créer une photo à partir de multiples images

Oliprot

XLDnaute Nouveau
Bonjour à tous,
Je souhaiterais après avoir insérer d'autres images sur ma photo principale enregistrer le tout sous un fichier jpg sur mon disque dur. La photo finale sera toujours comprise dans le range C3:H24 (Je vous joins un fichier exemple de ce que je souhaite).
J'ai commencé un code mais hélas, je bloque sur un bug et je n'y arrive plus :(
Quelqu'un peut-il me débloquer ?
Merci pour votre aide.
Olivier.
 

Pièces jointes

  • Dessin Image.zip
    40.3 KB · Affichages: 45

PMO2

XLDnaute Accro
Re : Créer une photo à partir de multiples images

Bonjour,

Une piste avec le code suivant à copier dans un module standard
(je ne crois pas que cela fonctionnera sous Excel 2007 ou supérieur ???)

Code:
'### 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

Je ne joins aucune pièce car elle dépasse la limite de taille autorisée.


Cordialement.

PMO
Patrick Morange
 
Dernière édition:

Oliprot

XLDnaute Nouveau
Re : Créer une photo à partir de multiples images

Bonjour Patrick, bonjour le forum,
Merci pour ta réponse et le temps que tu m'accordes.
Cependant, vers la fin de la procédure à la commande CO.Chart.Paste, j'ai une erreur d'exécution 1004 (la méthode 'Paste' a échoué).
J'ai Excel 2003 SP3.
As-tu une petite idée ?
Cordialement.
 

Oliprot

XLDnaute Nouveau
Re : Créer une photo à partir de multiples images

Bonsoir à tous,

Pour info pour le forum, voici la solution ( Merci encore à PMO ) :

Code:
Option Explicit

'### Constantes à adapter ###
Const PLAGE_PHOTO As String = "C3:H24"
Const CHEMIN As String = "C:\temp\"
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 05/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

Bonne continuation.
 

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 330
Membres
103 187
dernier inscrit
ebenhamel