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
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
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
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
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
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
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
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
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
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
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
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
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" a écrit dans le message de news: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
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" <catochem@autocyclo.com> a écrit dans le message de news:
u7Jq8ODjIHA.4076@TK2MSFTNGP05.phx.gbl...
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
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" a écrit dans le message de news: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
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 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 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.
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" a écrit dans le message de news:
%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" a écrit dans le message de news: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
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
%23HUN1UDjIHA.1944@TK2MSFTNGP02.phx.gbl...
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" <catochem@autocyclo.com> a écrit dans le message de news:
u7Jq8ODjIHA.4076@TK2MSFTNGP05.phx.gbl...
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
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" a écrit dans le message de news:
%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" a écrit dans le message de news: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
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" a écrit dans le message de news:
%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" a écrit dans le message de news:
%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" a écrit dans le message de news: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
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
%23IZSBNEjIHA.1164@TK2MSFTNGP02.phx.gbl...
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
%23HUN1UDjIHA.1944@TK2MSFTNGP02.phx.gbl...
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" <catochem@autocyclo.com> a écrit dans le message de news:
u7Jq8ODjIHA.4076@TK2MSFTNGP05.phx.gbl...
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
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" a écrit dans le message de news:
%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" a écrit dans le message de news:
%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" a écrit dans le message de news: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
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
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
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