Coller une image différente dans chaque feuille

Question

Bonjour et bonnes fêtes de fin d'année.

Je voudrais coller une image jpg différente dans chaque feuille à un endroit précis.

Ces photos ( de cartes grises ) se trouvent dans un dossier spécifique et portent le même nom unique que les onglets.

J'ai trouvé sur internet un code qui me crée les onglets et qui me les supprime. Je voudrai maintenant ajouter dans la boucle du code le copier-coller de la photo dans la cellule AA de chaque onglet. Malheureusement certains onglets n'ont pas de cartes grises et donc on passe au suivant jusqu'à ce que la dernière photo soit insérée.

Voici le code d'ajout

Public Sub AjVeh()

    Dim oShModele As Worksheet
    Dim oShVoirie As Worksheet
    Dim oshBd As Worksheet
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim oShNew As Worksheet
    Dim sNomOnglet As String

    Set oShModele = Worksheets("Modele")
    Set oShVoirie = Worksheets("Voirie")
    Set oshBd = Worksheets("BD")

    iLigFin = oShVoirie.Range("A" & Rows.Count).End(xlUp).Row  'C

    For iLig = 3 To iLigFin
        If oShVoirie.Range("A" & iLig).Value <> "" Then
            sNomOnglet = oShVoirie.Range("A" & iLig).Value
            If OngletExist(sNomOnglet) Then
                Set oShNew = Worksheets(sNomOnglet)
            Else
                oShModele.Copy After:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = sNomOnglet
                Set oShNew = Worksheets(Worksheets.Count)
            End If
            oShNew.Range("A1").Value = oShVoirie.Range("A" & iLig).Value 'Vehicule
            'oShNew.Range("F3").Value = oShListe.Range("C" & iLig).Value 'Nom
            'lien hypertext
            oShNew.Hyperlinks.Add Anchor:=oShVoirie.Range("A" & iLig), Address:="", SubAddress:= _
                    "'" & sNomOnglet & "'!A3", TextToDisplay:=oShVoirie.Range("A" & iLig).Value
            Set oShNew = Nothing
        End If
    Next iLig

    oShVoirie.Select

    Set oShVoirie = Nothing
    Set oShModele = Nothing
    Set oshBd = Nothing

End Sub

Et voici le code de suppression

Option Explicit
Public Sub SuVeh()
    Dim oSh As Worksheet
    Const strongModele As String = "Modele"
    Const strongVoirie As String = "Voirie"
    Const strongBD As String = "BD"
        If MsgBox("Suppression des véhicules ?", vbYesNoCancel + vbExclamation) <> vbYes Then
            Exit Sub
        End If
        For Each oSh In Worksheets
        If oSh.Name <> strongVoirie And oSh.Name <> strongModele And oSh.Name <> strongBD Then
            Application.DisplayAlerts = False
            oSh.Delete
            Application.DisplayAlerts = True
        End If
    Next oSh
End Sub

Le répertoire des photos est " Cartes Grises "

Il faut que je teste si le Sheet.name correspond au texte du nom de la photo mais là ça dépasse mes compétences. Je ne sais même pas où je pourrais trouver un code qui aille dans un répertoire chercher une donnée, enfin c'est très compliqué. Je crois que c'est Windows Scripting, non ?

Bon, je sais qu'avec les fêtes, les gens se reposent et en profitent ce qui est normal. Alors je comprends votre indifférence et ne vous tiendrai pas rigueur car vous êtes des bénévoles et des experts aussi. Vous n'avez aucune obligation d'aider des gens comme moi. Mais si vous le faites, c'est parce que vous aimez aussi ce site que j'ai découvert et que je trouve vraiment extraordinaire, clair et efficace.

Allez BONNE ANNEE 2019

Invité · Answer

Je pense qu'avant "bonne année 2019", il y a "bonnes fêtes de fin d'année" Ensuite dans ton code je vois que tu défini ta variable de ligne en Integer Dim iLigFin As Integer Dim iLig As Integer Tu vas avoir de sérieux problèmes... l'integer ne vas que jusqu'à 32.767 or Excel contient beaucoup plus de lignes Pour savoir si un fichier (image) existe, tu as la fonction : DIR() A+...