Sand_s_Wizard
Messages postés2Date d'inscriptionmercredi 15 juin 2005StatutMembreDernière intervention15 juin 2005
-
15 juin 2005 à 16:56
Sand_s_Wizard
Messages postés2Date d'inscriptionmercredi 15 juin 2005StatutMembreDernière intervention15 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.
Sand_s_Wizard
Messages postés2Date d'inscriptionmercredi 15 juin 2005StatutMembreDernière intervention15 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
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