resolu : comment ajouter une image

[Marti Marti]

Bonjour forum
Bonjour a tous et a toutes
SVP ..
J'ai trop essayer mais sans resultat
Comment svp faire pour que je puisse ajouter une image au diaporama ..ici l'image 4
Merci beaucoup d'avance pour l'aide

REMARQUE : j'ai posté ce sujet dans ce lien mais aucune reponse obtenue
comment ajouter une image : Excel - VBA

Cordialement
MARTI

 

[Modeste geedee]

Re : comment ajouter une image

Bonsour®
il aurait été plus rapide de poser la question à l'auteur de la proc

mais ne désespère pas , JB fréquente régulièrement ce forum ...

 

[job75]

Re : comment ajouter une image

Bonjour Marti Marti, Modeste geedee,

En attendant JB une solution dans le fichier joint.

Il faut préalablement créer l'image ActiveX et la nommer Photo4.

Ensuite fermez l'USF, créez (dans Module1) et lancez (Ctrl+A) cette macro :

Sub EncapsulerImage()
'Touches Ctrl+A pour lancer la macro
Dim NomImage$, NomPhoto$, s As Shape, fichier$
NomImage = InputBox("Nom de l'image à encapsuler :")
NomPhoto = InputBox("Nom de la photo (ActiveX) :")
Application.ScreenUpdating = False
On Error Resume Next
Set s = f.Shapes(NomImage)
fichier = ThisWorkbook.Path & "\" & s.Name & ".jpg"
s.CopyPicture
With f.ChartObjects.Add(0, 0, s.Width, s.Height).Chart
  .Paste
  .Export fichier, "JPG"
  .Parent.Delete
End With
f.OLEObjects(NomPhoto).Object.Picture = LoadPicture(fichier)
Kill fichier
Unload Userform1
auto_open 'relance le diaporama
End Sub

A+

 

[job75]

Re : comment ajouter une image

Re,

Si vous avez d'autres photos à ajouter suivez bien sûr la même procédure.

Simplement nommez vos images ActiveX Photo5 Photo6 etc...

A+

 

[Marti Marti]

Re : comment ajouter une image

Bonsoir job75
Heureux de vous rencontrer dans ce sujet une autre fois
Merci 1000 fois pour ces solutions
Je vais essayer de faire ce que vous avez dites
Amicalement
MARTI

 

[Marti Marti]

Re : comment ajouter une image

Bonsoir job75
Je ne sais pas pourquoi j'ai pas pu ouvrir le fichier du post #3
Merci beaucoup d'avance de m'aider a voir où est le probleme
Amicalement
MARTI

 

[job75]

Re : comment ajouter une image

Re,

Aucune idée là-dessus.

J'ai ouvert ce fichier sans problème sur mes 2 ordis avec win 7 - Excel 2010 et Win 8 - Excel 2013.

A+

 

[Marti Marti]

Re : comment ajouter une image

Bonsoir job75
moi je travaille sur Win 8 Excel 2010
Je sais que la faute est chez moi ..mais où .. je vais essayer encore
Merci enormement pour votre reponse
Amicalement
MARTI

 

[Marti Marti]

Re : comment ajouter une image

Bonsoir job75
Merci Merci Merci pour votre superbe fichier et conseils
RESOLU
Amicalement
MARTI

 

[job75]

Re : resolu : comment ajouter une image

Bonjour Marti Marti, le forum,

Avec cette solution la nouvelle image ActiveX (Photo4) est créée automatiquement :

Sub EncapsulerImage()
'Sélectionner l'image à encapsuler
'Touches Ctrl+A pour lancer la macro
If TypeName(Selection) = "Range" Then Exit Sub
Dim o As Object, fichier$
Set f = Sheets("Photos")
Application.ScreenUpdating = False
Set o = Selection
fichier = ThisWorkbook.Path & "\" & o.Name & ".jpg"
o.CopyPicture
With f.ChartObjects.Add(0, 0, o.Width, o.Height).Chart
  .Paste
  .Export fichier, "JPG"
  .Parent.Delete
End With
For Each o In f.OLEObjects
  If o.Name = "Photo" & f.OLEObjects.Count Then
    o.Select
    Selection.Copy
    o.TopLeftCell.Offset(1).Select
    ActiveSheet.Paste
    Selection.Name = "Photo" & f.OLEObjects.Count
    Selection.Object.Picture = LoadPicture(fichier)
    ActiveCell.Activate
    [A1].Copy: Application.CutCopyMode = 0 'vide le presse-papiers
    Exit For
  End If
Next
Kill fichier
auto_close
Application.OnTime 1, "auto_open" 'relance le diaporama
End Sub

C'est donc très simple : il suffit de sélectionner l'image à encapsuler.

Fichier (2).

Remarque 1 : l'image peut être créée pendant que le diaporama tourne.

Remarque 2 : la macro majHeure qui tourne en arrière-plan empêche de passer en Mode Création.

Pour y arriver il faut provisoirement la neutraliser en exécutant par exemple la macro auto_close.

Edit : ajouté [A1].Copy: Application.CutCopyMode = 0 'vide le presse-papiers

A+

 

[Marti Marti]

Re : resolu : comment ajouter une image

Bonsoir job75
Mes excuses pour le retard de vous repondre j'etais absent pendant toute la journee
une superbe solution plus facile pour moi le debutant
merci 1000 fois pour votre aide on vous trouve toujours avec vos meilleurs solutions
amicalement
MARTI

 

[job75]

Re : resolu : comment ajouter une image

Bonjour Marti Marti, le forum,

On peut traiter d'un coup un ensemble d'images :

Sub EncapsulerImage()
'Touches Ctrl+A pour lancer la macro
Dim image As Object, fichier$, o As Object
Set f = Sheets("Photos")
Application.ScreenUpdating = False
For Each image In f.Pictures
  If Not image.Name Like "Photo*" And Not image.Name Like "* OK" Then
    fichier = ThisWorkbook.Path & "\" & image.Name & ".jpg"
    image.CopyPicture
    With f.ChartObjects.Add(0, 0, image.Width, image.Height).Chart
      .Paste
      .Export fichier, "JPG"
      .Parent.Delete
    End With
    For Each o In f.OLEObjects
      If o.Name = "Photo" & f.OLEObjects.Count Then
        o.Select
        Selection.Copy
        o.TopLeftCell.Offset(1).Select
        ActiveSheet.Paste
        Selection.Name = "Photo" & f.OLEObjects.Count
        Selection.Object.Picture = LoadPicture(fichier)
        image.Name = image.Name & " OK" 'repérage
        Exit For
      End If
    Next o
    Kill fichier
  End If
Next image
ActiveCell.Activate
[A1].Copy: Application.CutCopyMode = 0 'vide le presse-papiers
auto_close
Application.OnTime 1, "auto_open" 'relance le diaporama
End Sub

Il n'y a plus rien à faire, juste lancer la macro.

Les images traitées sont repérées par "OK" afin d'être ignorées ensuite.

Fichier (3).

Edit : si Ctrl+A ne fonctionne pas lancer par l'onglet DÉVELOPPEUR => Macros.

On peut aussi utiliser un bouton, fichier (3 bis).

Bonne journée.

 

[Marti Marti]

Re : resolu : comment ajouter une image

Bonjour job75
Magnifiques codes et super suivi
Merci 1000 fois
Cordialement
MARTI