Récupéré le chemin dun répertoire

Sand_s_Wizard
Messages postés
2
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
15 juin 2005
- 15 juin 2005 à 16:56
Sand_s_Wizard
Messages postés
2
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
15 juin 2005
- 15 juin 2005 à 16:59
bonjour,

je suis nouveau et je n'ai pas trop l'habitude de programmer

j'ai fait le code source suivant en m'aidant de diverses sources sur le net et les livres. malheureusement, il fonctionnait jusqu'aux moment où j'ai voulut "l'automatiser" avec un bouton sur ma page excel

d'après ce que j'ai compris de ce qu'il effectue, il ne va pas chercher le bon chemin du répertoire par contre le reste semble fonctionner.

je vous remercie d'avance pour vos réponse.

1 réponse

Sand_s_Wizard
Messages postés
2
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
15 juin 2005

15 juin 2005 à 16:59
désolé j'ai oublié le code.

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
Dim dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez le dossier pour le traitement des données."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H4000
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 listefic()

j = 2
i = 2
k = 2


nom = Dir(chemin)


Sheets("Feuil1").Select


If nom = "" Then
MsgBox ("il n'y a rien a traité")
End If
While nom <> ""
Range("a" & i).Value = nom
nom = Dir()
i = i + 1
Wend


n = 1
Do
n = n + 1
Loop Until Sheets("feuil1").Range("A" & n).Text = ""


j = 2


nom = Range("A" & j).Text
While nom <> ""
Range("A" & j).Select
Cells.Find(What:=".out", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.Copy
Range("C" & j).Select
ActiveSheet.Paste
j = j + 1
nom = Range("A" & j).Text
Wend


i = 2
k = 3


While Range("C" & i + 1) <> ""
While Range("C" & k) <> ""
If Range("c" & i).Text <> Range("c" & k).Text Then
k = k + 1
Else
Range("c" & k).Select
Selection.Delete Shift:=xlUp
End If
Wend
i = i + 1
k = i + 1
Wend


Cells.Replace What:=".out", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False


End Sub


Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 08/06/2005 par aswu8393
'


'
GetDirectory
chemin = lettre & dossier


Workbooks.Add
ActiveWorkbook.SaveAs Filename:=chemin & "resultat.xls", FileFormat:=xlNormal, Password:="", ReadOnlyRecommended:=False, CreateBackup:=False


listefic


If Range("C2").Text <> "" Then
ChDir chemin
k = 2
l = 2
Windows("Classeur3.xls").Activate
Sheets("Feuil1").Activate
While Range("c" & k).Value <> ""
nom = Range("c" & k).Value
Workbooks.OpenText Filename:=chemin & nom & ".out", Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
, 1), Array(4, 1)), TrailingMinusNumbers:=True


Range("A1").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Range("B1") = nom

j = 2
c = 20
p = 2
While (p < 65536 And Cells(p, 1) <> "")
p = p + 1
Wend
If p < 65536 Then
Do
j = j + 1
A = Cells(j, 1).Value
b = Cells(j + 1, 1).Value
d = b - A
If d > c Then
Range(Cells(j + 1, 1), Cells(j + 1, 4)).Select
Selection.EntireRow.Insert Shift
j = j + 2
End If
Loop Until j + 1 = 65536
End If
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Windows("resultat.xls").Activate
Range(Cells(1, l), Cells(1, l)).Select
l = l + 1
ActiveSheet.Paste
If k = 2 Then
Windows(nom & ".out").Activate
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Windows("resultat.xls").Activate
Range("A1").Select
ActiveSheet.Paste
End If
Windows(nom & ".out").Activate
ActiveWorkbook.Close
Windows("Classeur3.xls").Activate
Sheets("Feuil1").Activate
k = k + 1
Wend
Else
MsgBox ("il n'y a rien a traité")
End If
End Sub
0