Filesearch non reconnu sous Office 2007

Le
catochem
Bonjour,

Ma macro créee sous Excel 2002 ne fonctionne plus avec Office 2007,
Application.FileSearch n'est plus reconnu, savez-vous comment détourner le
problème ?

Voici la macro, son principe est de créeer un lien hypertexte dans Excel à
chaque fois qu'un fichier image.jpg est reconnu dans un dossier connu et de
passer à la cellule suivante :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
With Application.FileSearch
.RefreshScopes
.NewSearch
.LookIn = "F:Prodvisuels_2008"
.SearchSubFolders = False
.Filename = Nom_Image
.MatchTextExactly = True
If .Execute > 0 Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" &
Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
'
End Sub '

Merci pour votre aide
Catochem
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #5331941
Bonjour.
Essaie :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Cordialement.
Daniel
"catochem"
Bonjour,

Ma macro créee sous Excel 2002 ne fonctionne plus avec Office 2007,
Application.FileSearch n'est plus reconnu, savez-vous comment détourner le
problème ?

Voici la macro, son principe est de créeer un lien hypertexte dans Excel à
chaque fois qu'un fichier image.jpg est reconnu dans un dossier connu et
de
passer à la cellule suivante :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
With Application.FileSearch
.RefreshScopes
.NewSearch
.LookIn = "F:Prodvisuels_2008"
.SearchSubFolders = False
.Filename = Nom_Image
.MatchTextExactly = True
If .Execute > 0 Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" &
Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
'
End Sub '

Merci pour votre aide
Catochem




Misange
Le #5331901
Bonjour,

Ma macro créee sous Excel 2002 ne fonctionne plus avec Office 2007,
Application.FileSearch n'est plus reconnu, savez-vous comment détourner le
problème ?

Merci pour votre aide
Catochem


Bonjour


J'ai mis la semaine dernière sur excelabo un classeur exemple montrant
comment remplacer file.search dans 2007 :-)

--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

catochem
Le #5331851
Merci Daniel pour votre reactivité, j'ai essayé sans succès

La macro bloque ici : "Attendu Fin d'instruction"
fich = Dir("F:Prodvisuels_2008" & Nom_Image)

En vérité je n'y connait rien au language VB, on me l'a faite il y a 2 ans
mais je l'utilise tout les jours et elle me manque...

Voyez-vous ce qui coince ?
Merci

"Daniel.C" %
Bonjour.
Essaie :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Cordialement.
Daniel


Misange
Le #5331831
http://www.excelabo.net/excel/xl07div.php#filesearch07
Public Function getDir(path As String, sortie As String) As Variant
Dim fList() As String
Dim iPosition As Long
Dim iSize As Long
Dim sFile As String
Dim fRange As Excel.Range
Const iIncrement As Long = 50

iSize = iIncrement
ReDim fList(1 To iSize)
'vous pouvez indiquer *.* pour obtenir la liste de tous les fichiers ou
filtrer par l'extension
sFile = Dir(path & IIf(Right(path, 1) = "", "", "") & "*.xls")

Do While Len(sFile)
iPosition = iPosition + 1
If iPosition > iSize Then
iSize = iSize + iIncrement
ReDim Preserve fList(1 To iSize)
End If
fList(iPosition) = sFile
sFile = Dir
Loop

If iSize > iPosition Then
ReDim Preserve fList(1 To iPosition)
End If

Set fRange = Range(sortie).Resize(iPosition, 1)
fRange.Value = WorksheetFunction.Transpose(fList)
fRange.Sort key1:=fRange.Cells(1), order1:=xlAscending
getDir = fRange.Value

End Function

pour utiliser cette fonction depuis une macro, en utilisant l'adresse du
répertoire située en A1 et pour restituer la liste des fichiers dans en
E1, E2 ...

Public Sub FileSearch2007()
Dim v As Variant
v = getDir(Feuil1.Cells(1, 1), "E1")
End Sub

--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
catochem
Le #5331791
Merci Misange, j'ai suivi le lien de vore précédent message et j'étais en
train de me demander où intégrer le code dans mon ancienne macro, qu'elles
variant...

En gros je crois que je suis incapable de modifier quoi que ce soit,
avez-vous un peu de temps pour me fournir la solution "clé en main" d'après
se que disait ma précédente macro (lien hypertexte...)

C'est la première fois que je m'inscris dans un forum, j'espère ne pas vous
choquer en vous demandant de faire le boulot à ma place.

Merci pour votre coopération et inutile de préciser que s'il vous faut des
infos supplémentaire pour la compréhension de mon besoin, je suis là !
évidemment !
Catochem

"Misange"
http://www.excelabo.net/excel/xl07div.php#filesearch07
Public Function getDir(path As String, sortie As String) As Variant
Dim fList() As String
Dim iPosition As Long
Dim iSize As Long
Dim sFile As String
Dim fRange As Excel.Range
Const iIncrement As Long = 50

iSize = iIncrement
ReDim fList(1 To iSize)
'vous pouvez indiquer *.* pour obtenir la liste de tous les fichiers ou
filtrer par l'extension
sFile = Dir(path & IIf(Right(path, 1) = "", "", "") & "*.xls")

Do While Len(sFile)
iPosition = iPosition + 1
If iPosition > iSize Then
iSize = iSize + iIncrement
ReDim Preserve fList(1 To iSize)
End If
fList(iPosition) = sFile
sFile = Dir
Loop

If iSize > iPosition Then
ReDim Preserve fList(1 To iPosition)
End If

Set fRange = Range(sortie).Resize(iPosition, 1)
fRange.Value = WorksheetFunction.Transpose(fList)
fRange.Sort key1:=fRange.Cells(1), order1:=xlAscending
getDir = fRange.Value

End Function

pour utiliser cette fonction depuis une macro, en utilisant l'adresse du
répertoire située en A1 et pour restituer la liste des fichiers dans en
E1, E2 ...

Public Sub FileSearch2007()
Dim v As Variant
v = getDir(Feuil1.Cells(1, 1), "E1")
End Sub

--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net


Daniel.C
Le #5331761
Désolé.
Essaie plutôt :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Daniel
"Daniel.C" %
Bonjour.
Essaie :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Cordialement.
Daniel
"catochem"
Bonjour,

Ma macro créee sous Excel 2002 ne fonctionne plus avec Office 2007,
Application.FileSearch n'est plus reconnu, savez-vous comment détourner
le
problème ?

Voici la macro, son principe est de créeer un lien hypertexte dans Excel
à
chaque fois qu'un fichier image.jpg est reconnu dans un dossier connu et
de
passer à la cellule suivante :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
With Application.FileSearch
.RefreshScopes
.NewSearch
.LookIn = "F:Prodvisuels_2008"
.SearchSubFolders = False
.Filename = Nom_Image
.MatchTextExactly = True
If .Execute > 0 Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" &
Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
'
End Sub '

Merci pour votre aide
Catochem








Misange
Le #5331731
Merci Misange, j'ai suivi le lien de vore précédent message et j'étais en
train de me demander où intégrer le code dans mon ancienne macro, qu'elles
variant...

En gros je crois que je suis incapable de modifier quoi que ce soit,
avez-vous un peu de temps pour me fournir la solution "clé en main" d'après
se que disait ma précédente macro (lien hypertexte...)

C'est la première fois que je m'inscris dans un forum, j'espère ne pas vous
choquer en vous demandant de faire le boulot à ma place.


regarde alors ce que Daniel a corrigé ;-)

--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

catochem
Le #5331671
C'est beaucoup mieux car la macro s'exécute en boucle mais je ne créee pas
mes liens hypertexte comme auparavant. Ce qui revient à dire que je ne peux
pas l'utiliser comme ça.

Dans excel je créee une colonne dans laquelle chaque cellule porte déjà le
nom de l'image.jpg (ex : 100.jpg) la macro visite mon répertoire qui
contient les images et rajoute un lien hypertexte au nom déjà inscrit dans
la cellule.

De ce fait je peux me rendre compte des références pour lesquelles il me
manque une image ou s'il en existe une, l'ouvrir depuis excel.

Bon je n'aime pas cette position de demandeur mais pouvez-vous aller pour me
dépanner ?


"Daniel.C" %
Désolé.
Essaie plutôt :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Daniel
"Daniel.C" %
Bonjour.
Essaie :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Cordialement.
Daniel
"catochem"
Bonjour,

Ma macro créee sous Excel 2002 ne fonctionne plus avec Office 2007,
Application.FileSearch n'est plus reconnu, savez-vous comment détourner
le
problème ?

Voici la macro, son principe est de créeer un lien hypertexte dans Excel
à
chaque fois qu'un fichier image.jpg est reconnu dans un dossier connu et
de
passer à la cellule suivante :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
With Application.FileSearch
.RefreshScopes
.NewSearch
.LookIn = "F:Prodvisuels_2008"
.SearchSubFolders = False
.Filename = Nom_Image
.MatchTextExactly = True
If .Execute > 0 Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" &
Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
'
End Sub '

Merci pour votre aide
Catochem












Daniel.C
Le #5331631
Il faut que la cellule active active soit sur le premier nom de fichier.
Si la colonne à droite de la cellule active est disponible, exécute le code
suivant :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
J'inscris un "fichier x non trouvé" en face de ceux pour lequel je ne trouve
pas d'équivalence.
Si l'erreur persiste, mets un classeur exemple sur www.cjoint.com et poste
ici l'adresse générée.
Daniel
"catochem"
C'est beaucoup mieux car la macro s'exécute en boucle mais je ne créee pas
mes liens hypertexte comme auparavant. Ce qui revient à dire que je ne
peux pas l'utiliser comme ça.

Dans excel je créee une colonne dans laquelle chaque cellule porte déjà le
nom de l'image.jpg (ex : 100.jpg) la macro visite mon répertoire qui
contient les images et rajoute un lien hypertexte au nom déjà inscrit dans
la cellule.

De ce fait je peux me rendre compte des références pour lesquelles il me
manque une image ou s'il en existe une, l'ouvrir depuis excel.

Bon je n'aime pas cette position de demandeur mais pouvez-vous aller pour
me dépanner ?


"Daniel.C" %
Désolé.
Essaie plutôt :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Daniel
"Daniel.C" %
Bonjour.
Essaie :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Cordialement.
Daniel
"catochem"
Bonjour,

Ma macro créee sous Excel 2002 ne fonctionne plus avec Office 2007,
Application.FileSearch n'est plus reconnu, savez-vous comment détourner
le
problème ?

Voici la macro, son principe est de créeer un lien hypertexte dans
Excel à
chaque fois qu'un fichier image.jpg est reconnu dans un dossier connu
et de
passer à la cellule suivante :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Nom_fichier_image = Application.FileSearch.Filename
'Déclaration de la variable récupérant le texte de la cellule pour
aller
chercher l'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
With Application.FileSearch
.RefreshScopes
.NewSearch
.LookIn = "F:Prodvisuels_2008"
.SearchSubFolders = False
.Filename = Nom_Image
.MatchTextExactly = True
If .Execute > 0 Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" &
Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(1, 0).Select
End If
End With
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
'
End Sub '

Merci pour votre aide
Catochem
















catochem
Le #5331581
Daniel ! ça fonctionne, merci mille fois !

Si j'abuse dîtes le moi, mais tant que je vous tiens pouvez-vous aussi
m'indiquer une autre macro (tjrs pour le même fichier excel) qui peut écrire
les dimensions (en pixel) de l'image trouvée dans une autre colonne ?

Et merci encore, si vous ne me répondez pas à cette requête considérez quand
même que vous avez fait une heureuse aujourd'hui.

"Daniel.C" %
Il faut que la cellule active active soit sur le premier nom de fichier.
Si la colonne à droite de la cellule active est disponible, exécute le
code suivant :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("F:Prodvisuels_2008" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "F:Prodvisuels_2008" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
J'inscris un "fichier x non trouvé" en face de ceux pour lequel je ne
trouve pas d'équivalence.
Si l'erreur persiste, mets un classeur exemple sur www.cjoint.com et poste
ici l'adresse générée.
Daniel


Publicité
Poster une réponse
Anonyme