Insérer photos d'un dossiers dans feuille excel

  • Initiateur de la discussion Initiateur de la discussion billouu
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

billouu

XLDnaute Junior
Bonjour,

Je souhaiterais insérer plusieurs photos d'un dossier en donnant le nom du dossier à l'aide d'une message box de type parcourir et que l'ensemble de photos s'insère les une sous les autres aux dimensions de la cellule.

Voici le début de la macro:

Private Sub CommandButton1_Click()






Dim ficimg As Variant
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = ActiveCell.Top ' haut de la cellule
.Left = ActiveCell.Left ' gauche de la cellule
.Height = ActiveCell.RowHeight ' hauteur de la cellule
.Width = ActiveCell.Width ' largeur de la cellule
End With
With Selection
.PrintObject = True ' l'objet est imprimé en même temps que le document
.Placement = xlMoveAndSize ' manière dont l'objet est lié aux cellules
End With



End Sub

D'avance merci.

Billouu
 
Re : Insérer photos d'un dossiers dans feuille excel

Re,

J'ai une macro qui fonctionne bien seulement par moment des photos ne sont pas insérés. Sauriez vous pourquoi?
Voici la macro:

Private Sub ButtonOk_Click() 'ceci si on utilise l'userf présent

On Error GoTo Fin

For x = 1 To 50000

Cells(x + 10, 3).Activate
Dim photo As Variant
photo = TextBox3.Value & "\0 (" & x & ").jpg"


ActiveSheet.Pictures.Insert(photo).Select ' insertion
With Selection.ShapeRange
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = ActiveCell.Top ' haut de la cellule
.Left = ActiveCell.Left ' gauche de la cellule
.Height = ActiveCell.RowHeight ' hauteur de la cellule
.Width = ActiveCell.Width ' largeur de la cellule
End With
With Selection
.PrintObject = True ' l'objet est imprimé en même temps que le document
.Placement = xlMoveAndSize ' manière dont l'objet est lié aux cellules
End With

Next x
Fin:

If x = 1 Then
MsgBox "Vérifiez que vos photos soit nommées comme ceci : 0 (1), 0 (2),... " & Chr(10) & "Pour cela, sélectionner toutes les photos du dossier puis faite renommer sur la première et appuyer sur 0"
Exit Sub

End If

If Err.Number = 18 Then MsgBox "Opération annulée."

Unload Me
End Sub

D'avance merci
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
1 K
Réponses
39
Affichages
5 K
  • Question Question
Microsoft 365 choisir une page
Réponses
6
Affichages
806
Retour