'---------------------------------------------------------------------------------------
' Procédure : fctInsererIMG
' Auteur : A.G.
' Date : 19/02/2012
' Description : Insérer une image dans une zone avec mise à l'échelle et alignement
'---------------------------------------------------------------------------------------
'
Sub fctInsererIMG(sChemin As String, sNomImage As String, sNomZone As String, eTypeAlignement As eLstAlignement)
'> Supprimer l'ancienne image
'----------------------------
' Parcourir les formes à la recherche de l'image et la supprimer
For Each ShapeObj In ActiveSheet.Shapes
If ShapeObj.Name = sNomImage Then ActiveSheet.Shapes(sNomImage).Delete
Next ShapeObj
'> Insérer la nouvelle image
'---------------------------
Dim vZonePosL As Variant
Dim vZonePosT As Variant
Dim vZoneTailW As Variant
Dim vZoneTailH As Variant
' Position / Taille de la zone
vZonePosL = Range(sNomZone).Left
vZonePosT = Range(sNomZone).Top
vZoneTailW = Range(sNomZone).Width
vZoneTailH = Range(sNomZone).Height
' Insérer l'image
Dim oImage As Shape
Set oImage = ActiveSheet.Shapes.AddPicture(sChemin, True, True, vZonePosL, vZonePosT, vZoneTailW, vZoneTailH)
'> Dimensionner l'image
'----------------------
' Nommer l'image
oImage.Name = sNomImage
' Mettre à l'échelle 1 l'image
oImage.ScaleWidth 1, msoTrue
oImage.ScaleHeight 1, msoTrue
' Conserver les proportions
oImage.LockAspectRatio = msoTrue
' Dimensions de l'image
Dim vImgTailW As Variant
Dim vImgTailH As Variant
vImgTailW = oImage.Width
vImgTailH = oImage.Height
' Image plus large ou plus haute que la zone
If vImgTailW > vZoneTailW Or vImgTailH > vZoneTailH Then
' Image plus large que la zone
If vImgTailW > vZoneTailW Then
' Ajuster par rapport à la largeur
oImage.Width = vImgTailW * (vZoneTailW / vImgTailW)
End If
' Nouvelle taille de l'image
vImgTailW = oImage.Width
vImgTailH = oImage.Height
' Image plus haute que la zone
If vImgTailH > vZoneTailH Then
' Ajuster par rapport à la hauteur
oImage.Height = vImgTailH * (vZoneTailH / vImgTailH)
End If
End If
'> Alignement de l'image
'-----------------------
Dim vImgPosL As Variant
Dim vImgPosT As Variant
' Nouvelle taille de l'image
vImgTailW = oImage.Width
vImgTailH = oImage.Height
' Alignement Horizontal
Select Case eTypeAlignement
' Aligner à Gauche
Case eLstAlignement.BasGauche, eLstAlignement.MilieuGauche, eLstAlignement.HautGauche
vImgPosL = vZonePosL
' Aligner au Centre
Case eLstAlignement.BasCentre, eLstAlignement.MilieuCentre, eLstAlignement.HautCentre
vImgPosL = vZonePosL + ((vZoneTailW / 2) - (vImgTailW / 2))
' Aligner à Droite
Case eLstAlignement.BasDroite, eLstAlignement.MilieuDroite, eLstAlignement.HautDroite
vImgPosL = vZonePosL + (vZoneTailW - vImgTailW)
End Select
' Alignement Vertical
Select Case eTypeAlignement
' Aligner en Haut
Case eLstAlignement.HautDroite, eLstAlignement.HautGauche, eLstAlignement.HautCentre
vImgPosT = vZonePosT
' Aligner au Milieu
Case eLstAlignement.MilieuDroite, eLstAlignement.MilieuGauche, eLstAlignement.MilieuCentre
vImgPosT = vZonePosT + ((vZoneTailH / 2) - (vImgTailH / 2))
' Aligner en Bas
Case eLstAlignement.BasDroite, eLstAlignement.BasGauche, eLstAlignement.BasCentre
vImgPosT = vZonePosT + (vZoneTailH - vImgTailH)
End Select
' Positionner l'image
oImage.Top = vImgPosT
oImage.Left = vImgPosL
End Sub