Afficher un message
Vieux 23/04/2007, 20h04   #4 (permalink)
tatiak
XLDnaute Impliqué
 
Avatar de tatiak
 
Date d'inscription: février 2005
Messages: 549
Par défaut Re : Codes pour la gestion du dimensionnement de la taille des photos dans une cellule

Bon, j'ai trouvé la réponse à ma question.
La méthode OFFSET n'est pas en cause dans l'affaire!

Le soucis vient de la méthode INSERT pour insérer une image dans une cellule d'XL. Pour ce faire, dans Excel 2007, il est nécessaire d'inserer une photo dans un cadre, lui même inséré au préalable dans la cellule!

Une procédure d'intégration de photo en VBA XL2007 serait donc du type :
Code:
Sub IntegrationPhotoUnique(ligne As Long)
Dim chemin As String
Dim Col As Byte
Dim sh As Shape
Dim CoinGhe As Single, BordHaut As Single
Dim Hauteur As Single, Largeur As Single
    Col = 5
    With Sheets("Catalogue").Range("C" & ligne)
        If Not .Value = "" Then
            chemin = ActiveWorkbook.Path & "\" & .Text & ".gif"
            If Not ExisteGIF(chemin) Then chemin = ActiveWorkbook.Path & "\" & .Text & ".JPG"
            If Not ExisteGIF(chemin) Then chemin = ActiveWorkbook.Path & "\" & .Text & ".BMP"
            If Not ExisteGIF(chemin) Then chemin = ActiveWorkbook.Path & "\PasImage.GIF"
            If ExisteGIF(chemin) Then
                With Range("Catalogue!H" & ligne)
                    Hauteur = .Height
                    Largeur = .Width
                    CoinGhe = .Left
                    BordHaut = .Top
                End With
                Set sh = Sheets("Catalogue").Shapes.AddShape(msoShapeRectangle, CoinGhe, BordHaut, Largeur, Hauteur)
                If IsNumeric(.Value) Then
                    sh.Name = Str$(.Value)
                Else
                    sh.Name = .Value
                End If
                sh.Fill.UserPicture chemin
                sh.Height = Hauteur
            End If
        End If
    End With
End Sub

Public Function ExisteGIF(Image As String) As Boolean
Dim ttk As Object
    Set ttk = CreateObject("Scripting.FileSystemObject")
    ExisteGIF = ttk.FileExists(Image)
End Function
(ici le rectangle est nommé pour l'affacer plus facilement secondairement)

C'est Mericc qui est chargé des tests en réel de la procédure car je ne suis pas équipé en XL2007!!!
__________________
Visitez le Blog-à-tatiak!
tatiak est déconnecté   Réponse avec citation