Erreur macro

apprentiVB -  
 apprentiVB -
Bonjour,


J'ai une macro qui fonctionnait à merveille avant mon changement de PC, que j'avais récupéré, je l'avais un peu modifiée mais rien de méchant vu qu'elle fonctionnait :

Sub SelectCol()
Range("C:C").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 = 200 ' 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 = "Afficher les images " & vbCrLf

r = MsgBox(msg, vbOKCancel, "Cellules où mettre les images")
If r = vbOK Then
r = 0
Else
Cancel = True: Exit Sub
End If
h = InputBox("Hauteur des lignes :", "Choix hauteur", hDefaut)
For Each c In Selection
c.ColumnWidth = 20
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
c.RowHeight = h 'fixer la hauteur de ligne
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportions
.Height = h - 4 'hauteur de l'image = hauteur des lignes - 4
.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


Cette macro me permet d'insérer des images extraites d'un fichier word et de les insérer dans mon fichier excel.
Cependant, depuis quelques temps cette macro bug quand je l'applique. Le débogage proposé est à partir de la ligne mise en gras.
La fenêtre d'erreur est Erreur d'exécution 13. Je suis un peu perdu, je n'ai pourtant rien modifié sur la macro.
Merci d'avance pour l'aide que vous m'apporterez
A voir également:

2 réponses

Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Bonjour,

Une piste :
Remplacer
Dim fich
Par
Dim fich As String
et s'assurer que les cellules sélectionnées contiennent un lien texte
Cordialement
Patrice
0
apprentiVB
 
j'ai désormais un autre message d'erreur qui appariaut :
"La méthode 'ColumnWidth' de l'objet 'Range' a échoué"
0