Optimisation et images

Bonjour a tous,

je suis en train de développer un formulaire excel ou certaines feuilles contiennent jusqu'à 15 images.

J' ai créer une macro pour aider à inserer, légender et compresser l'image. Cependant, le parc informatique est composé de machine peu puissante (4GO ram) ce qui rend impossible l'utilisation de cette focntionalié (à partir de 2-3 images insérés, on observe de gros lags, voir des problème de excel (ne répond pas)

Avez vous des astuces ou conseil, changement dans le code pour permettre l'insertion de 15 images sans trop de problèmes.

code :

Sub IMAGEINSERTION(Zone As String, num As String, condilegend As Boolean, Optional lignelegend As Long, Optional colonnelegend As Long)

'Programmme qui insert et compresse une image avec ajout de la légende
'arguments:
'zone : coordonnées de l'emplacement
'num : nom de l'image: ciblen°
'condilegend : si ajout légende
'lignelegend : n° ligne de la légende (optionnel)
'colonnelegend : n° colonne de la légende (optionnel)

Application.ScreenUpdating = False 'active écran=optimisation
Dim Emplacement As Range
Dim Img As Object
Dim ShapeObj As Shape

'Boucle pour supprimer l'ancienne image
For Each ShapeObj In ActiveSheet.Shapes
If ShapeObj.name = num Then ActiveSheet.Shapes(num).Delete
Next ShapeObj


If Application.Dialogs(xlDialogInsertPicture).Show Then
'Définit l'emplacement de l'image
Set Emplacement = Range(Zone)

' legende de l'image automatique
If condilegend Then
Dim legende As String
legende = InputBox("Entrer la légende de l'image ?", "Légende de l'image") 'La variable reçoit la valeur entrée dans l'InputBox
Cells(lignelegend, colonnelegend).Value = legende

End If

Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
CompressPic

With Img.ShapeRange
'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
.name = num
.LockAspectRatio = msoTrue
.Height = Emplacement.Height 'hauteur = hauteur du champ

End With

Img.Top = Emplacement.Top + Emplacement.Height / 2 - Img.Height / 2 'Centrage de l'image dans le champ
Img.Left = Emplacement.Left + Emplacement.Width / 2 - Img.Width / 2

Application.ScreenUpdating = True 'active écran=optimisation

Else
Application.ScreenUpdating = True 'active écran=optimisation
MsgBox "Insertion d'image interrompue."
End If

End Sub

Sub CompressPic()
'compression de l'image
'simulation de la suite des cliques d'un utilisateur

Dim octl As CommandBarControl
With Selection
Set octl = Application.CommandBars.FindControl(ID:=6382)
Application.SendKeys "%e~"
Application.SendKeys "%a~"
octl.Execute

End With

End Sub

Bonjour,

Excel et VBA ne sont pas des logiciels de traitement d'images :

Utilise ton traitement d'image préféré et mets des images compressées dans un répertoire ad-hoc.

Après 15 images Ok si c'est de images de 100 Ko maximum , mais au delà y faudrait peut-être penser à réduire la voilure hein !

A+

Bonsoir,

dans les options Excel, liée au classeur actuel ou à l'application (il faut voir) il y a celle qui concerne les compressions d'images.
Ceci veut dire qu'Excel nativement est capable de compresser les images pour un gain de place et ce en fonction de l'information donnée dans les options.

Cela permettra peut-être plus de souplesse que de le gérer par VBA.

@ bientôt

LouReeD