[mericc]

Bonjour à tous!

Voilà je pense que ce sujet peut se mettre dans la rubrique Excel 2007:

J'ai pu arriver (avec l'aide (précieuse) de tatiak) à affecter des photos
dans une colonne selon la référence de la photo.

Le problème (dernier..dernier pb...dernière ligne droite) relève du dimension-
nement des photos insérées dans chacune des cellules.

Pour faire simple, il y a deux macros:

une première macro (macro1) qui comporte notamment les codes suivants
pour gérer le dimensionnement des photos:

Proportion = .Offset(0, 1).Height / tatiak.Height 'pour garder la bonne proportion de la photo
tatiak.Height = .Offset(0, Col).Height
tatiak.Width = tatiak.Width * Proportion
tatiak.Left = .Offset(0, Col).Left
tatiak.Top = .Top

Et la deuxième macro(macro2), le code suivant:

tatiak.Left = .Offset(0, Col).Left
tatiak.Top = .Top
tatiak.Width = .Offset(0, Col).Width
tatiak.Height = .Offset(0, Col).Height

On peut voir dans le fichier joint (print écran) la différence de la taille
des photos en 4 possibilités:

macro 1/ excel 2002-sp3

macro 1/ excel 2007

macro 2/ excel 2002-sp3

macro 2/ excel 2007

[IMG][/IMG]




Le "dysfonctionnement" dans Excel 2007 est très "visible" dans la colonne F
(macro1/excel2007) où l'on ne voit plus du tout la photo de la flèche discontinue et verticale..

Par contre la flèche est identique pour la macro1/excel2002 et la macro2/excel 2007 <<<<< voir colonnes D et J..

Alors y aurait il une gestion du code différente dans excel2007 tel que le
code est écrit (reprise du code plus haut ci après):

Proportion = .Offset(0, 1).Height / tatiak.Height 'pour garder la bonne proportion de la photo
tatiak.Height = .Offset(0, Col).Height
tatiak.Width = tatiak.Width * Proportion
tatiak.Left = .Offset(0, Col).Left
tatiak.Top = .Top

Est ce que ces élément vont sont suffisants pour aider à résoudre ce
problème?

Merci d'avance

Eric

ps: et un salut chaleureux à Tatiak en passant...

nb: j ai au boulot excel 2007 et à la "zonmé" excel 2002...
évidemment il suffirait de ne travailler que sur 2002 ..mais
c'est bête mais au boulot, ils ont carrément désinstallé
l ancienne version d excel..

[tatiak]

Salut Eric,
Essaye de modifier la ligne :
tatiak.Height =.Offset(0, Col).Height
par :
tatiak.Height = Range("Catalogue!H" & ligne).Height

La question que je me pose, et que je pose au forum c'est de savoir si XL2007 gère l'instruction OFFSET de la même manière que sur XL2000??
Merci de vos réponses

[mericc]

Bonsoir Tatiak..

Eh bien..j 'ai ramené à la maison un portable pro avec excel 2007..
donc j ai la chance de pouvoir faire les changements que tu as
suggéré..

Ca fonctionne comme précédemment..la "flèche" reste toujours
aussi "chtite"..quasi invisible..

Décidément...
Comme tu dis...dans les évolutions d' Excel 2007, il doit y avoir
des zones "pas forcément claires"...

Bon en tout cas...avec la synergie des compétences du forum..
je reste confiant..

A vous lire..à te lire..

Eric

[tatiak]

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 :

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!!!

[mericc]

Bonsoir tous! Bonsoir tatiak!

modif faite...
en fait les photos sont effectivement lisibles
et prennent place dans toute la cellule..

un new problème arrive cependant à partir
de la 10ème cellule(à peu près)...où un léger décalage
s'opère et en faisant un test jusqu'à la photo
de la 142ème référence (dernière référence par hypothèse,
en commencant en H3), cette dernière photo est décalée
quasiment de son tiers inférieur et ce tiers inférieur
déborde sur le haut de la cellule H145 (vide)

Le décalage se fait progressivement au fur et à mesure
que les photos s'égrenent ...

Je mettrai demain..un print..



Sacré excel 2007 didiou...

Et bravo tatiak...car les choses évoluent...dans le sens
positif (ceci dit pour comprendre tous les tenants et
les aboutissants du code, va falloir que je me greffe des neurones!
)

quant au décalage est ce que ca viendrait de la taille
des photos qui sont différentes..certes le nombre de Ko
est léger..mais ca varie..

good night eve-riz-beau-dit!

Eric

ps: petite amélioration visuelle, les photos sont bien encadrées..

[mericc]

salut à tous.. salut tatiak!
Je rentre du boulot!
zouuu je m y remets..
Eric

[mericc]

Bonsoir tous
Bonsoir Tatiak

Je t ai envoyé un mél où je t explique
que finalement..avec au moins 140
références et des photos qui peuvent
faire au moins 1,3 méga (j ai vérifié)
les photos se décalent toujours..
on le voit bien sur à la dernière photo
(ligne 143 si je ne me trompe pas, enfin
là peu importe c est au dejà de 140 lignes)..
Et donc comme je te dis dans mon mail,
c est en jouant sur la hauteur de ligne
que je peux corriger (pas complétement
ceci dit) le décalage...

Pour info à tous, voici le code que j'ai...

Option Explicit

Public Etat As Boolean
______________________________________
'Sub testPhoto()
'Dim nbligne As Long, i As Long
'Dim sh As Object
'nbligne = Range("Catalogue!B65000").End(xlUp).Row
' For Each sh In Sheets("Catalogue").Shapes
' MsgBox (sh.Name)
' Next sh
'End Sub

'Sub EffacePhoto()
'Dim nbligne As Long, i As Long
' nbligne = Range("Catalogue!B65000").End(xlUp).Row
' For i = 3 To nbligne
' EffacePhotoUnique (i)
' Next i
'End Sub
______________________________
Sub EffacePhoto() 'Unique(ligne As Long)
Dim sh As Object
For Each sh In Sheets("Catalogue").Shapes
If Left(sh.Name, 3) = "Img" Then sh.Delete
Next sh
End Sub
_________________________________
Sub EffacePhotoUnique(ligne As Long)
Dim sh As Object
Dim nomimage As String
If IsNumeric(Range("Catalogue!C" & ligne).Value) Then
nomimage = Str(Range("Catalogue!C" & ligne).Value)
Else
nomimage = Range("Catalogue!C" & ligne).Value
End If
For Each sh In Sheets("Catalogue").Shapes
If sh.Name = nomimage Then sh.Delete
Next sh
End Sub
___________________________________

Sub Integration_toutes_Photos()
Dim nbligne As Long, i As Long
nbligne = Range("Catalogue!B65000").End(xlUp).Row
For i = 3 To nbligne
IntegrationPhotoUnique (i)
Next i
End Sub
_______________________________________
Sub IntegrationPhoto()
Dim nbligne As Long, i As Long
EffacePhoto
nbligne = Range("Catalogue!B65000").End(xlUp).Row
For i = 3 To nbligne
If Etat Then
If Range("Catalogue!D" & i).Value = "C" Then IntegrationPhotoUnique (i)
Else
If Range("Catalogue!D" & i).Value <> "C" Then IntegrationPhotoUnique (i)
End If
Next i
End Sub
_________________________________________
'Sub IntegrationPhotoUnique(ligne As Long)
'Dim chemin As String
'Dim tatiak As Object
'Dim Col As Byte
'dim Proportion 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
' Set tatiak = Sheets("Catalogue").Pictures.Insert(chemin)
' If IsNumeric(.Value) Then
' tatiak.Name = Str(.Value) 'nomme la photo selon sa référence, en vue de l'effacer secondairement
' Else
' tatiak.Name = .Value
' End If
'Proportion = .Offset(0, 1).Height / tatiak.Height "pour garder la bonne proportion de la photo
'tatiak.Height = .Offset(0, Col).Height
' tatiak.Height = Range("Catalogue!H" & ligne).Height
' tatiak.Width = .Offset(0, Col).Width 'tatiak.Width * Proportion
' tatiak.Left = .Offset(0, Col).Left
' tatiak.Top = .Top
' End If
' End If
' End With
'End Sub
________________________________________________
'Sub IntegrationPhotoUnique(ligne As Long)
'Dim chemin As String
'Dim tatiak As Object << désactivation
'Dim Col As Byte
'Dim sh As Shape 'ajout
'Dim CoinGhe As Single, BordHaut As Single 'ajout
'Dim Proportion As Single << désactivation
'Dim Hauteur As Single, Largeur As Single ' ajout
' 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
'Set tatiak = Sheets("Catalogue").Pictures.Insert(chemin)
'If IsNumeric(.Value) Then
' tatiak.Name = Str(.Value) 'nomme la photo selon sa référence, en vue de l'effacer secondairement
'Else
' tatiak.Name = .Value
'End If
'Proportion = .Offset(0, 1).Height / tatiak.Height 'pour garder la bonne proportion de la photo
'tatiak.Height = .Offset(0, Col).Height
'tatiak.Height = Range("Catalogue!H" & ligne).Height
'tatiak.Width = tatiak.Width * Proportion
'tatiak.Left = .Offset(0, Col).Left
'tatiak.Top = .Top
' With Range("Catalogue!H" & ligne)
' Hauteur = .Height
' Largeur = .Width
' CoinGhe = .Left
' BordHaut = .Top
' End With
' Set sh = Sheets("Catalogue").Shapes.AddShape(msoShapeRectan gle, 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
__________________________________________
Sub IntegrationPhotoUnique(ligne As Long)
Dim Image As String, LargeurImage As Single, Gauche As Single
Dim sh As Shape, tatiak As Object
With Sheets("Catalogue").Range("C" & ligne)
For Each sh In Sheets("Catalogue").Shapes
If sh.Name = "Img" & .Value Then Exit Sub
Next sh
If Not .Value = "" Then
Image = ActiveWorkbook.Path & "\" & .Text & ".gif"
If Not ExisteGIF(Image) Then Image = ActiveWorkbook.Path & "\" & .Text & ".JPG"
If Not ExisteGIF(Image) Then Image = ActiveWorkbook.Path & "\" & .Text & ".BMP"
If Not ExisteGIF(Image) Then Image = ActiveWorkbook.Path & "\PasImage.GIF"
If ExisteGIF(Image) Then
Set tatiak = Sheets("Catalogue").Pictures.Insert(Image)
With Range("Catalogue!H" & ligne)
LargeurImage = tatiak.Width * .Height / tatiak.Height
Gauche = .Left + (.Offset(0, 1).Left - .Left - LargeurImage) / 2
tatiak.Delete
Set sh = Sheets("Catalogue").Shapes.AddShape(msoShapeRectan gle, _
Gauche, .Top, .Width, .Height)
End With
sh.Name = "Img" & .Value
sh.Fill.UserPicture Image
sh.Height = .Height
sh.Width = LargeurImage
End If
End If
End With
End Sub
_____________________________________________
Public Function ExisteGIF(Image As String) As Boolean
Dim tatiak As Object
Set tatiak = CreateObject("Scripting.FileSystemObject")
ExisteGIF = tatiak.FileExists(Image)
End Function

>>>>>>>> J'ai désactivé certains codes précédents
sans les effacer pour garder trace..

voilà voilà

en tout cas ca reste gérable comme je te le dis dans mon
mél.
ceci dit si jaaaaaaaamais y avait un chti bug à corriger
je suis toujours...preneur..pour la correction..

en tout cas..mes zaaaaamis (ceussss qui lisent), châââpeau
bas à Mister Tatiak!

Have a "goût de night"..

Eric

PS: le décalage "corrigé" en jouant avec la hauteur de ligne
arrive à avoir un résultat tel que seulement environ 10%de la
dernière photo ne soit pas calée comme elle devrait l'être..
Alors "poids des photos" , autres? (faut il convertir toutes les photos
à des tailles plus raisonnables par exemple)<<< Je ne sais point!

[mericc]

dernier mot..par contre sous excel version 2002 sp3
un vrai bonheur ...aucun problème..tout est nickel
chrome..

Que ce soit dit!

Eric