Démarrer macro sur la cellule A4

julos08

XLDnaute Nouveau
Bonjour a tous,

Voila jai une macro qui me cherche des dossiers dans le c:.
elle m'affiche tous les dossiers trouvé dans une feuille excel dans la colonne A
Le premier resultat saffiche sur A1 et jaimerai quelle saffiche sur A4

Comment faire je suis coincé.

Voila mon code
---------------------------------------------------------------------------
Dim Msg, Style, Title, Response, MyString
Dim fso As Object, fld As Object, iCounter As Integer, stComp As String
---------------------------------------------------------------------------
Sub StartScan()
'coPath est le chemin du dossier dans lequel on effectue la recherche
Choix_Format.CommandButton1.Visible = False
Choix_Format.CommandButton2.Visible = False
Choix_Format.WebBrowser1.Visible = True


Const coPath = 'C:\\'
stComp = vbNullString: iCounter = 0
Do While Len(stComp) = 0
stComp = Choix_Format.TextBox1.Value
Loop
stComp = '*' & LCase(stComp) & '*'
Set fso = CreateObject('scripting.filesystemobject')
Application.Cursor = xlWait
Call ListFld(coPath)
Application.Cursor = xlNormal

ActiveSheet.UsedRange.EntireColumn.AutoFit
Choix_Format.WebBrowser1.Visible = False
Unload Choix_Format
Msg = 'Recherche terminée voulez vous faire une autre recherche' ' Définit le message.
Style = vbYesNo + vbInformation + vbDefaultButton2 ' Définit les boutons.
Title = 'test' ' Définit le titre.

Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
Choix_Format.Show
Else ' L'utilisateur a choisi Non.
MyString = 'Non' ' Effectue une action
End If

End Sub
---------------------------------------------------------------------------
Sub ListFld(stInput As String)
On Error Resume Next
For Each fld In fso.getfolder(stInput).subfolders
If LCase(fld.Name) Like stComp Then
iCounter = iCounter + 1

Range('A' & iCounter).Value = fld.Path
End If
Call ListFld(fld.Path)
DoEvents
Next fld

End Sub
---------------------------------------------------------------------------
Merci
@++
julos08
 

PascalXLD

XLDnaute Barbatruc
Modérateur
Bonjour

Comme le dit Pierre initialise ta variable

Sub ListFld(stInput As String)
On Error Resume Next
iCounter =3
For Each fld In fso.getfolder(stInput).subfolders
If LCase(fld.Name) Like stComp Then
iCounter = iCounter + 1

Range('A' & iCounter).Value = fld.Path
End If
Call ListFld(fld.Path)
DoEvents
Next fld

End Sub

Bon courage
 

Statistiques des forums

Discussions
312 668
Messages
2 090 739
Membres
104 643
dernier inscrit
adriano22