Programmation sous excel

Merci mais je ne parvien pas à accédé au lien. Voici ce que la page affiche :
Forbidden
You don't have permission to access / on this server.
Apache/2.2.16 (Unix) mod_ssl/2.2.16 OpenSSL/0.9.8o Server at cjoint.com Port 80

Bonjour

Apparemment, cette interdiction vient de chez toi...

ci dessous les macros
comme il doit s'agir de photos d'identité, tu peux supprimer les lignes du code concernant la prise en compte du format horizontal d'une photo
dans l'exemple on présente les colonnes A à D (relire mon 1° message)

Option Explicit

Sub incorporer_image()
Dim Derlig As Integer, Design As String, Cptr As Integer, Chemin As String
Dim Fichier As String, Image As Picture, Cellule As Range, Rapport As Byte, Numero As Integer
     'initialisations
     Derlig = Columns("A").Find("*", , , , , xlPrevious).Row
     Application.ScreenUpdating = False
     'parcours la liste
     Numero = 1
     For Cptr = 2 To Derlig
          Design = Cells(Cptr, "C")
          Chemin = ThisWorkbook.Path & "\" & "photos\"
          'prend en compte le format de la photo
          If Dir(Chemin & Design & ".png") <> "" Then Design = Design & ".png"
          If Dir(Chemin & Design & ".jpg") <> "" Then Design = Design & ".jpg"
          If Dir(Chemin & Design & ".jpeg") <> "" Then Design = Design & ".jpeg"
          If Dir(Chemin & Design & ".gif") <> "" Then Design = Design & ".gif"
          On Error GoTo inconnu
          Fichier = Chemin & Design
           Set Cellule = Cells(Cptr, "D")
           Set Image = ActiveSheet.Pictures.Insert(Fichier)
          'insere l'mage web dans la liste du matos
          On Error GoTo 0
          'ajuste la photo à la cellule
           With Image.ShapeRange
               .Top = Cellule.Top + 1
               .Left = Cellule.Left + 1
                Rapport = Round((Image.Width) / 21.16, 0) / Round((Image.Height) / 21.16, 0)
                If Rapport >= 1 Then
                    .Height = Cellule.Height - 10
                    .Width = Cellule.Width - 2
                    .LockAspectRatio = msoFalse
               Else
                    .Height = Cellule.Height - 2
                    .Width = Cellule.Width - 60
                    .Left = Cellule.Left + .Width / 4 'centrage vertical
                    .LockAspectRatio = msoFalse
               End If
               .Name = "numphoto" & Numero
          End With
               Numero = Numero + 1
     Next
     Exit Sub
     
inconnu:
     MsgBox "Nom de photo inconnu", vbCritical, "galerie photo"
End Sub


Sub enlever_photos()
Dim Nbre As Byte, Numero As Byte
With Sheets(1)
     On Error Resume Next
     Nbre = Application.CountA(.Columns("C")) - 1
     For Numero = 1 To Nbre
          .Shapes("numphoto" & Numero).Delete
     Next
End With


End Sub

Salut Michel,

Ca va bien merci. Et toi?

Procédure complète, comme d'hab! J'aime bien le fait de ne pas stocker inutilement des images dans un classeur... D'où la nécessité de ta seconde procédure...
Petit question subsidiaire, pourquoi 21.16 dans la ligne :

Rapport = Round((Image.Width) / 21.16, 0) / Round((Image.Height) / 21.16, 0)

Bonjour,
pourquoi 21.16 ?
je ne sais plus pourquoi et je ne me souviens plus où j'ai pompé cette ligne....

si je retrouve, je te fais signe.... ;o)

peut être la largeur de la colonne du classeur concerné???

Salut michel,

C'est de pire en pire et, je trouve, de plus en plus insupportable...
Sur mes discussions suivies, je suis sur que moins de 30% des gens répondent et/ou remercient... Aucun retour! C'est réellement pénible.

Bonne journée à toi.

Salut,

Et encore, si on ne se fait pas engueuler après avoir fait remarquer l'impolitesse

a propos de 21.6, je viens de poser la question sur DVP....!

a propos de 21.6, je viens de poser la question sur DVP....!
Ok. Merci. En fait, j'aime bien comprendre...