Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire donné
(ex : d:mes icones) récupére tous les noms d'icones
sans l'extension .ico et me colle les noms dans ma
feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire donné
(ex : d:mes icones) récupére tous les noms d'icones
sans l'extension .ico et me colle les noms dans ma
feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire donné
(ex : d:mes icones) récupére tous les noms d'icones
sans l'extension .ico et me colle les noms dans ma
feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
bonjour Michel,
voici un exemple,
Sub TousFichiersDunDossier1()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer
Set fso =
CreateObject("Scripting.FileSystemObject")
NomDossier = "C:zaza" If NomDossier = "" Then Exit
Sub Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
x = x + 1
Range("A" & x) = File
Next
End If
End Sub
isabelle
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
bonjour Michel,
voici un exemple,
Sub TousFichiersDunDossier1()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer
Set fso =
CreateObject("Scripting.FileSystemObject")
NomDossier = "C:zaza" If NomDossier = "" Then Exit
Sub Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
x = x + 1
Range("A" & x) = File
Next
End If
End Sub
isabelle
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
bonjour Michel,
voici un exemple,
Sub TousFichiersDunDossier1()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer
Set fso =
CreateObject("Scripting.FileSystemObject")
NomDossier = "C:zaza" If NomDossier = "" Then Exit
Sub Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
x = x + 1
Range("A" & x) = File
Next
End If
End Sub
isabelle
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
Bonjour !
Macro une fois insérée dans un modèle standard,
peut-être à adapter un poil !
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll"
_ Alias "SHGetPathFromIDListA" (ByVal pidl As Long,
ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez le dossier à analyser."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function
Sub lance()
Dim spec As String
ThisWorkbook.Worksheets(1).Cells.ClearContents
spec = GetDirectory
If spec = "" Then: Err.Clear: Exit Sub
arbo spec
End Sub
Sub arbo(specdossier As String)
On Error Resume Next
Dim fs, f, fc, sf As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(specdossier)
Set fc = f.Files
With ThisWorkbook.WorkSheets(1)
For Each f1 In fc
If [A1] = "" Then
[A1] = Left(f1.Name, Len(f1.Name) - 4)
[B1] = specdossier
ElseIf [A2] = "" Then
[A2] = Left(f1.Name, Len(f1.Name) - 4)
[B2] = specdossier
Else
.Range("A1").End(xlDown).Range("A2").Value
= Left(f1.Name, Len(f1.Name) - 4)
End If
Next
Set sf = f.subfolders
For Each f1 In sf
arbo specdossier & "" & f1.Name
Next
End Sub
En cas de problème(s), n'hésite pas à faire de grands
signes !!
A+-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
Bonjour !
Macro une fois insérée dans un modèle standard,
peut-être à adapter un poil !
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll"
_ Alias "SHGetPathFromIDListA" (ByVal pidl As Long,
ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez le dossier à analyser."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function
Sub lance()
Dim spec As String
ThisWorkbook.Worksheets(1).Cells.ClearContents
spec = GetDirectory
If spec = "" Then: Err.Clear: Exit Sub
arbo spec
End Sub
Sub arbo(specdossier As String)
On Error Resume Next
Dim fs, f, fc, sf As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(specdossier)
Set fc = f.Files
With ThisWorkbook.WorkSheets(1)
For Each f1 In fc
If [A1] = "" Then
[A1] = Left(f1.Name, Len(f1.Name) - 4)
[B1] = specdossier
ElseIf [A2] = "" Then
[A2] = Left(f1.Name, Len(f1.Name) - 4)
[B2] = specdossier
Else
.Range("A1").End(xlDown).Range("A2").Value
= Left(f1.Name, Len(f1.Name) - 4)
End If
Next
Set sf = f.subfolders
For Each f1 In sf
arbo specdossier & "" & f1.Name
Next
End Sub
En cas de problème(s), n'hésite pas à faire de grands
signes !!
A+
-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
Bonjour !
Macro une fois insérée dans un modèle standard,
peut-être à adapter un poil !
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll"
_ Alias "SHGetPathFromIDListA" (ByVal pidl As Long,
ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez le dossier à analyser."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function
Sub lance()
Dim spec As String
ThisWorkbook.Worksheets(1).Cells.ClearContents
spec = GetDirectory
If spec = "" Then: Err.Clear: Exit Sub
arbo spec
End Sub
Sub arbo(specdossier As String)
On Error Resume Next
Dim fs, f, fc, sf As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(specdossier)
Set fc = f.Files
With ThisWorkbook.WorkSheets(1)
For Each f1 In fc
If [A1] = "" Then
[A1] = Left(f1.Name, Len(f1.Name) - 4)
[B1] = specdossier
ElseIf [A2] = "" Then
[A2] = Left(f1.Name, Len(f1.Name) - 4)
[B2] = specdossier
Else
.Range("A1").End(xlDown).Range("A2").Value
= Left(f1.Name, Len(f1.Name) - 4)
End If
Next
Set sf = f.subfolders
For Each f1 In sf
arbo specdossier & "" & f1.Name
Next
End Sub
En cas de problème(s), n'hésite pas à faire de grands
signes !!
A+-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
-----Message d'origine-----
Merci Vincent
comme j'écrivais à Isabelle, je ne comprends pas
tout le code, alors je décortique un peu plus
chaque fois
pour m'instructionner (ouai) , j'ai l'impression
que plus j'avance plus c'est compliqué..
je m'accroche !!!
bonne soirée
Vincent. a présenté l'énoncé suivant :Bonjour !
Macro une fois insérée dans un modèle standard,
peut-être à adapter un poil !
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll"
_ Alias "SHGetPathFromIDListA" (ByVal pidl As Long,
ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez le dossier à analyser."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function
Sub lance()
Dim spec As String
ThisWorkbook.Worksheets(1).Cells.ClearContents
spec = GetDirectory
If spec = "" Then: Err.Clear: Exit Sub
arbo spec
End Sub
Sub arbo(specdossier As String)
On Error Resume Next
Dim fs, f, fc, sf As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(specdossier)
Set fc = f.Files
With ThisWorkbook.WorkSheets(1)
For Each f1 In fc
If [A1] = "" Then
[A1] = Left(f1.Name, Len(f1.Name) - 4)
[B1] = specdossier
ElseIf [A2] = "" Then
[A2] = Left(f1.Name, Len(f1.Name) - 4)
[B2] = specdossier
Else
.Range("A1").End(xlDown).Range("A2").Value
= Left(f1.Name, Len(f1.Name) - 4)
End If
Next
Set sf = f.subfolders
For Each f1 In sf
arbo specdossier & "" & f1.Name
Next
End Sub
En cas de problème(s), n'hésite pas à faire de grands
signes !!
A+-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
--
Amicalement
Michel . P
.
-----Message d'origine-----
Merci Vincent
comme j'écrivais à Isabelle, je ne comprends pas
tout le code, alors je décortique un peu plus
chaque fois
pour m'instructionner (ouai) , j'ai l'impression
que plus j'avance plus c'est compliqué..
je m'accroche !!!
bonne soirée
Vincent. a présenté l'énoncé suivant :
Bonjour !
Macro une fois insérée dans un modèle standard,
peut-être à adapter un poil !
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll"
_ Alias "SHGetPathFromIDListA" (ByVal pidl As Long,
ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez le dossier à analyser."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function
Sub lance()
Dim spec As String
ThisWorkbook.Worksheets(1).Cells.ClearContents
spec = GetDirectory
If spec = "" Then: Err.Clear: Exit Sub
arbo spec
End Sub
Sub arbo(specdossier As String)
On Error Resume Next
Dim fs, f, fc, sf As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(specdossier)
Set fc = f.Files
With ThisWorkbook.WorkSheets(1)
For Each f1 In fc
If [A1] = "" Then
[A1] = Left(f1.Name, Len(f1.Name) - 4)
[B1] = specdossier
ElseIf [A2] = "" Then
[A2] = Left(f1.Name, Len(f1.Name) - 4)
[B2] = specdossier
Else
.Range("A1").End(xlDown).Range("A2").Value
= Left(f1.Name, Len(f1.Name) - 4)
End If
Next
Set sf = f.subfolders
For Each f1 In sf
arbo specdossier & "" & f1.Name
Next
End Sub
En cas de problème(s), n'hésite pas à faire de grands
signes !!
A+
-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
--
Amicalement
Michel . P
.
-----Message d'origine-----
Merci Vincent
comme j'écrivais à Isabelle, je ne comprends pas
tout le code, alors je décortique un peu plus
chaque fois
pour m'instructionner (ouai) , j'ai l'impression
que plus j'avance plus c'est compliqué..
je m'accroche !!!
bonne soirée
Vincent. a présenté l'énoncé suivant :Bonjour !
Macro une fois insérée dans un modèle standard,
peut-être à adapter un poil !
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll"
_ Alias "SHGetPathFromIDListA" (ByVal pidl As Long,
ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez le dossier à analyser."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function
Sub lance()
Dim spec As String
ThisWorkbook.Worksheets(1).Cells.ClearContents
spec = GetDirectory
If spec = "" Then: Err.Clear: Exit Sub
arbo spec
End Sub
Sub arbo(specdossier As String)
On Error Resume Next
Dim fs, f, fc, sf As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(specdossier)
Set fc = f.Files
With ThisWorkbook.WorkSheets(1)
For Each f1 In fc
If [A1] = "" Then
[A1] = Left(f1.Name, Len(f1.Name) - 4)
[B1] = specdossier
ElseIf [A2] = "" Then
[A2] = Left(f1.Name, Len(f1.Name) - 4)
[B2] = specdossier
Else
.Range("A1").End(xlDown).Range("A2").Value
= Left(f1.Name, Len(f1.Name) - 4)
End If
Next
Set sf = f.subfolders
For Each f1 In sf
arbo specdossier & "" & f1.Name
Next
End Sub
En cas de problème(s), n'hésite pas à faire de grands
signes !!
A+-----Message d'origine-----
Bonjour à toutes et tous,
Je souhaiterai qu'une macro lise un répertoire
donné (ex : d:mes icones) récupére tous les noms
d'icones sans l'extension .ico et me colle les
noms dans ma feuil1 colonne G
Une piste s'il vous plait ?
merci d'avance
--
Amicalement
Michel . P
.
--
Amicalement
Michel . P
.