Macro - centrer une image importé dans une cellule

Anarhim

XLDnaute Nouveau
Bonjour,
J'aurais besoin de votre aide pour modifier une macro.
Je ne m'y connais pas beaucoup en VBA mais à force de faire des recherches, je connais maintenant la base de la base (c'est à dire rechercher des macro sur internet, les rentrer dans mes documents et lorsque cela est nécessaire, les modifier en partie ou les fusionner avec d'autres pour qu'elles s'adaptent à mon cas(chose pour laquelle je ne suis pas encore très à l'aise).
Mon problème aujourd'hui est que je n'arrive pas à adapter une option à mon cas.

Mon document possède deux macros. La première me permet d'importer automatiquement une série d'image en fonction d'un lien généré automatiquement par une formule dans un onglet, la seconde me permet d'effacer la totalité des images présentent dans ce même onglet (lorsque je met à jour le dit onglet).

Le problème ici est que les images sont insérer dans la colonne F, de l'onglet DU (les liens étant dans le colonne G, masqué par défaut), mais elles apparaissent uniquement en haut à gauche de la cellule.

Serait-il possible de les centrer dans cette dernière ?


Sub SelectCol()
Sheets("DU").Select
Range("G:G").Select
Call AffImage
End Sub
_______________________________________________________________________________________
Sub AffImage()
' Sélectionner les cellules contenant un lien vers une image et appeler la macro
' AffImage les affichera sur le lien ou dans la colonne de gauche ou de droite
Const hDefaut = 28 ' hauteur des images
Const imgDefaut = "" ' saisir chemin complet et le nom de l'image par défaut à afficher si erreur
Dim msg As String, r As Long, h As Long, lmax As Long
Dim c As Range, numfich As Integer
Dim fich
msg = "Oui : Afficher les images à gauche des liens sélectionnés" & vbCrLf
msg = msg & "Non : Afficher les images sur les liens sélectionnés" & vbCrLf
msg = msg & "Annuler : Afficher les images à droite des liens sélectionnés"
r = MsgBox(msg, vbYesNoCancel, "Cellules où mettre les images")
If r = vbYes Then
r = -1
ElseIf r = vbNo Then
r = 0
Else
r = 1
End If
h = InputBox("Hauteur des lignes :", "Choix hauteur", hDefaut)
For Each c In Selection
'c.ColumnWidth = 10
fich = c.Value
' test fichier
If fich <> "" Then
If Left(fich, 7) = "http://" Then
' on conserve le lien sur le net
Else
numfich = FreeFile()
On Error GoTo errfich
Open fich For Input As #numfich
Close #numfich
On Error GoTo 0
End If
End If
'
If fich <> "" Then
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportions
.Left = c.Offset(0, r).Left + 2 'à gauche colonne A (sinon tu calcules avec la largeur de colonne)
.Top = c.Top + 2 'et positionner verticalement
End With
End If
Next c
Exit Sub
errfich:
fich = imgDefaut
Resume Next
End Sub
_______________________________________________________________________________________
Sub efface()
Dim img As Shape

For Each img In Sheets("DU").Shapes
img.Delete
Next

End Sub



Dans un autre cas, la macro fonctionne déjà actuellement mais serait-il possible de supprimer les boites de dialogue ? Car lorsque la macro est lancé, l'on me demande si je veux mettre l'image à droite, gauche... ainsi que la taille des images souhaités. Je voudrais que le tout s’exécute toujours à gauche de la formule, donc comme lorsque je clic sur "Oui", et que les images fassent toujours 28 (d'ailleurs, il s'agit de 28 quoi ?)


Merci beaucoup pour votre aide.

Cordialement.
 

Discussions similaires

Statistiques des forums

Discussions
285 184
Messages
1 866 441
Membres
156 720
dernier inscrit
xbrest
Haut Bas