Microsoft 365 Ajout d'une image VBA

mahakas · 17 Mai 2022

Bonjour à toutes et à tous,

J'ai un problème d'ajout d'une photo dans une trame prédéfinie et j'ai besoin de votre aide (je suis débutante)

Voici ma problématique :

Les titres de mes photos se trouve dans l'onglet "Tab recap" et dans la colonne 25
La trame où je souhaite mettre la photo se trouve dans l'onglet "Reserve" (la première cellule est B2)
Mes photos se trouvent dans le lien "C:\Users\prenom.nom\Documents\"

Mon programme VBA est comme suite :

Sub Remplissage_fiche_reserve()

Dim nbligne As Integer

nbligne = Sheets("Tab recap").Cells(2, 1).End(xlDown).Row

If Sheets("Tab recap").Cells(ligne, 25).Value <> "" Then
Sheets("Reserve").Pictures.Delete
Sheets("Reserve").Shapes.AddPicture _
"C:\Users\prenom.nom\Documents\", _
True, True, 121, 515, 270, 190
End If

Sheets("Reserve").Select
Sheets("Reserve").Range("B2").Select
Sheets("Reserve").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Quand j'exécute ma macro, ce message d'erreur s'affiche :

Saviez-vous qu'est-ce qu'il faut faire pour que ma macro fonctionne ?

En vous remerciant d'avance pour votre aide.

sylvanu · 17 Mai 2022

Bonjour Mahakas,
sans fichier test, difficile de répondre.
Mais déjà un point bizarre, vous utilisez la variable "ligne" sans l'avoir initialisée.
Vous initialisé "nbligne" mais pas "ligne".

mahakas · 17 Mai 2022

Bonjour Sylvanu,
Merci pour votre réponse.
Ci-dessous le fichier test. J'espère qu'il va vous permettre de comprendre ma problématique.

sylvanu · 17 Mai 2022

Impossible de faire tourner votre macro avec les images dans votre dossier.
Cependant la ligne :

VB:

Sheets("Reserve").Pictures.Delete "C:\Users\prenom.nom\Document", True, True, 121, 515, 270, 190

ne peut pas marcher la propriétés .Delete n'a pas besoin de paramètres.
dans la PJ j'ai fait un petit module indépendant qui insère une image dans la cellule photo et qui la centre. Le nom est donné d'une part par Chemin en dur et d'autre par par le tableau. Evidemment à adapter.

Code:

Sub InsereImage()
    ligne = 3
    If Sheets("Tab recap").Cells(ligne, 25).Value <> "" Then
        Sheets("Reserve").Pictures.Delete                           ' suppression des images
        Chemin = "g:\Users\PC_PAPA\Pictures\GIFS\Bonhomme\Petites\" ' chemin du dossier image à adapter
        NomImage = Chemin & Sheets("Tab recap").Cells(ligne, 25)    ' chemin de l'image
        Cells(22, 3).Select                                         ' selection cellule où mettre l'image
        ActiveSheet.Pictures.Insert(NomImage).Select                ' insertion image
        With Selection.ShapeRange                                   ' centrage image dans cellule
            .Left = Cells(22, 3).Left + (Cells(22, 3).Width / 2)
            .Top = Cells(22, 3).Top + (Cells(22, 3).Height / 2) - (.Height / 2)
        End With
    End If
    [A1].Select
End Sub

mahakas · 17 Mai 2022

Votre macro n'engendre pas d'erreur par contre aucune image n'est insérer.
J'ai adapté le lien "g:\Users\PC_PAPA\Pictures\GIFS\Bonhomme\Petites\" au mien
ensuite j'ai fait appelle à cette macro via le bouton de commande comme suite :
Private Sub CommandButton2_Click()
InsereImage
Remplissage_fiche_reserve
End Sub
Tout mes fiches sont bien remplies et enregistrées par mais sans photo !

L'idée est de remplir la fiche par les éléments du tableau et ensuite enregistrer ces fiches sous format pdf dans un dossier (nombre de pdf enregistrés = nombre de lignes du tableau)

Tout fonctionne bien sauf la partie recherche des photos dans le lien indiqué et le positionnement de cette dernière

sylvanu · 17 Mai 2022

Vous avez aussi modifiée le nom des images ?
Et votre chemin se termine bien par "\" ?

sylvanu · 17 Mai 2022

Si vous faites simplement InsereImage sans rien modifier, c'est le nom de l'image en cells(3,25) qui sera utilisée et elle seule.
Chez moi ça marche correctement :

Microsoft 365 Ajout d'une image VBA

mahakas

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

mahakas

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

mahakas

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Discussions similaires