Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 03/02/2012, 22h30   #1
Invité de passage
 
Homme K.
Inscription : janvier 2012
Messages : 7
Détails du profil
Informations personnelles :
Nom : Homme K.
Localisation : Canada

Informations professionnelles :
Secteur : Industrie

Informations forums :
Inscription : janvier 2012
Messages : 7
Points : 2
Points : 2
Par défaut erreur 70: dans une macro recursif

j essaie de créer un macro qui trouve le chemin d'un répertoire et aussi avec un décompte(objective secondaire). pour l instant j'ai un bloque sur oFld qui m indique qui est vide et la erreur 70 arrive.

c'est mon premier post ici...



Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub CommandButton2_Click()
 
Dim toto As String
 
MsgBox ababa("C:\", 0) & " repertoire total"
 
End Sub
 
 
Function ababa(stRep1 As String, deco As Integer) As String
 
Dim stRep 'Nom du répertoire à parcourir
Dim oFSO, oFld
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRep = stRep1
 
If oFSO.FolderExists(stRep) Then
 
 If Not IsNull(oFld) Then
 
    For Each oFld In oFSO.GetFolder(stRep).SubFolders
 
        If Right(oFld.Name, (Len(oFld) - Len(stRep))) = "amd64" Then
            MsgBox oFld
        End If
 
        deco = deco + 1
 
        Label1.Caption = deco
 
        stRep1 = oFld
 
        Call ababa(stRep1, deco)
 
        If Right(oFld, (Len(oFld) - Len(stRep))) = "i386" Then
            MsgBox oFld
        End If
        'MsgBox deco & " / " & Right(oFld, (Len(oFld) - Len(stRep)))
 
    Next
 
    End If
 
End If
 
ababa = deco
End Function
Kelap est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 04/02/2012, 10h44   #2
Expert Confirmé Sénior
 
Homme Daniel
aucune
Inscription : septembre 2011
Messages : 2 004
Détails du profil
Informations personnelles :
Nom : Homme Daniel
Localisation : France, Seine et Marne (Île de France)

Informations professionnelles :
Activité : aucune

Informations forums :
Inscription : septembre 2011
Messages : 2 004
Points : 4 035
Points : 4 035
Bonjour,

C'est parce que tu manies des dossiers systèmes. Il faut que tu fasses fonctionner Excel avec les droits "Administrateur". Avec Windows 7 ou Vista, clique sur le bouton Windows, entre "cmd" dans la fenêtre de recherche.Là où tu vois "cmd" dans les résultats, fais un clic droit et clique sur "exécuter en tant qu'administrateur". Dans la fenêtre qui s'ouvre, entre le chemin d'Excel (ici, c'est "C:\Program Files (x86)\Microsoft Office\OFFICE14\Excel.exe") et appuie sur Enttrée., Tu peux aussi ajouter :

pour sauter ces dossiers.
__________________
Cordialement.

Daniel

Citation:
La plus perdue de toutes les journées est celle où l'on n'a pas ri.
Chamfort
Daniel.C est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 07/02/2012, 22h13   #3
Invité de passage
 
Homme K.
Inscription : janvier 2012
Messages : 7
Détails du profil
Informations personnelles :
Nom : Homme K.
Localisation : Canada

Informations professionnelles :
Secteur : Industrie

Informations forums :
Inscription : janvier 2012
Messages : 7
Points : 2
Points : 2
j'ai finalement vote pour la gestion d'erreur. voici le tout qui marche tres bien.

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
 
 
Option Explicit
 
Private Sub Workbook_Open()
 
Dim poingdeoart As String
Dim bankfichier As String
Dim xxmax As Integer
Dim xxincr As Integer
Dim icifiadepla() As String
Dim icidosvis() As String
Dim icideou As String
Dim poingdeoartf As String
Dim Sup
 
    'gestion du tableau
    xxmax = 2 'nombre de fichier a installer
    poingdeoart = "C:\" 'point de depart
    poingdeoartf = poingdeoart
    ReDim icifiadepla(xxmax)
    ReDim icidosvis(xxmax)
 
    'liste des fichiers a installer
    icifiadepla(2) = "coco.txt"
    icidosvis(2) = "temp"
    icifiadepla(1) = "tata.txt"
    icidosvis(1) = "macros"
 
    'installation des fichiers
    For xxincr = 1 To xxmax
        If jeregarde(icifiadepla(xxincr)) = 1 Then'voir si le fichier source est a la bonne place
            poingdeoart = poingdeoartf
            Call jecopie(poingdeoart, icidosvis(xxincr), (poingdeoart & icifiadepla(xxincr)), icifiadepla(xxincr))
            MsgBox "IcI"
        Else
            MsgBox "this files is not in c:\  =>" & icifiadepla(xxincr)
            Exit Sub
        End If
    Next xxincr
 
    'pour fermer le programme
    Sup = MsgBox("do you want to leave", vbYesNoCancel)
    If Sup = vbYes Then
        ActiveWorkbook.Close
    End If
 
End Sub
 
Function jecopie(stRep1 As String, dosvis As String, deou As String, fiadepla As String)
 
Dim stRep
Dim oFSO, oFld
Dim iTemp As Integer
Dim aa As Integer
Dim conca As String
 
'gestion des variable et objet
aa = 0
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRep = stRep1
 
If oFSO.FolderExists(stRep) Then
 
 If Not IsNull(oFld) Then
 
    For Each oFld In oFSO.GetFolder(stRep).SubFolders
    On Error Resume Next
 
        If LCase(Right(oFld.Name, (Len(oFld) - Len(stRep)))) = LCase(dosvis) Then
 
            conca = oFld & "\" & fiadepla
 
            'On Error Resume Next
            iTemp = GetAttr(conca)
            Select Case err.Number
                Case Is <> 0
                    FileCopy deou, conca
            End Select
 
        Else
 
            stRep1 = oFld
            Call jecopie(stRep1, dosvis, deou, fiadepla)
 
        End If
 
    Next
 
    End If
 
End If
 
End Function
 
 
 
Function jeregarde(lefichier As String) As Integer
 
Dim concajr As String
Dim iTemp As Integer
 
    jeregarde = 0
    concajr = "C:\" & lefichier
 
    On Error Resume Next
    iTemp = GetAttr(concajr)
    Select Case err.Number
        Case Is = 0
            jeregarde = 1
    End Select
 
End Function
Kelap est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 08/02/2012, 10h57   #4
Expert Confirmé Sénior
 
Homme Daniel
aucune
Inscription : septembre 2011
Messages : 2 004
Détails du profil
Informations personnelles :
Nom : Homme Daniel
Localisation : France, Seine et Marne (Île de France)

Informations professionnelles :
Activité : aucune

Informations forums :
Inscription : septembre 2011
Messages : 2 004
Points : 4 035
Points : 4 035
Merci du retour. Marque la question comme résolue, ça aidera ceux qui chercheront la même chose.
__________________
Cordialement.

Daniel

Citation:
La plus perdue de toutes les journées est celle où l'on n'a pas ri.
Chamfort
Daniel.C est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité Cette discussion est résolue.
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 17h46.


 
 
 
 
Partenaires

Hébergement Web