Discussion :

[newbie75]

Bonjour à Tous,

Suite à une création massive de fichiers xml, nous avons codé un petit programme qui permet de générer plusieurs fichier xml en modifiant certaines valeurs nécessaire au projet, le programme ce termine bien mais un petit message d'erreur fait son apparition "l'indice n'appatient pas à la sélection"

j'ai volontairement effacé le contenu du fichier xml ..


Code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'Fonction permettant de creer le fichier XML à partir de coefSA et du tableau d'idPRM
Function creationFichier(coefSA, tableauIdPrm, cheminEnregistrement, nomFichier) As String
Dim intFic As String
Dim contenu As String
Dim i As Long
Dim mp As String
Dim ld As Date
 
mp = "MAJ_Pas"
ld = Date
 
 
contenu = "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
contenu = contenu & "
intFic = FreeFile
cheminFichierEnregistrement = cheminEnregistrement & "/" & nomFichier & ".xml"
Open cheminFichierEnregistrement For Output As intFic
Print #intFic, contenu
Close intFic
Application.DisplayAlerts = True
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'Renvoie du nom du fichier
Function recuperationFichier() As String
Sheets("Feuil1").Select
recuperationFichier = ActiveWorkbook.ActiveSheet.Range("B9").Value
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'Renvoie l'idPRM
Function recuperationidPRM() As String
Sheets("Feuil1").Select
recuperationidPRM = ActiveWorkbook.ActiveSheet.Range("B6").Value
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'Renvoie le chemin d'enregistrement
Function repertoireEnregistrement() As String
Sheets("Feuil1").Select
repertoireEnregistrement = ActiveWorkbook.ActiveSheet.Range("B7").Value
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
'Renvoie le coefSA
Function recuperationCOEFSA() As Long
Sheets("Feuil1").Select
temp = ActiveWorkbook.ActiveSheet.Range("B8").Value
'recuperationCOEFSA =
If (IsNumeric(temp) = False) Then
   MsgBox ("Le coefSA doit être un nombre")
   recuperationCOEFSA = False
Else
    recuperationCOEFSA = temp
End If
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'Recopie le fichier d idPRM 
'il faut rendre ce chemin variable
Sub copieFichierIDPRM(Chemin)
    Workbooks.Open Filename:=Chemin
    Columns("A:A").Select
    Selection.Copy
 
    ActiveWorkbook.Close SaveChanges:=False
 
    Windows("CreationFichierSC03_V2.xlsm").Activate
    Sheets("Feuil2").Select
    Range("A1").Select
    ActiveSheet.Paste
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
    'Renvoie un tableau contenant les éléments de la colonne A
Function arrayIdPrm(coefSA, repertoireE, nomFichier) As Variant
 
    'Définit le type de données pour le tableau.
    Dim tableauIdPrm() As String
    Dim i As Long
    Dim nb As Currency
 
 
    Sheets("Feuil2").Select
 
    'Définit la taille du tableau
    nb = WorksheetFunction.CountA(Columns("A:A"))
    'ReDim tableauIdPrm(nb)
 
    'On insère les données dans le tableau
    For i = 1 To nb
        'tableauIdPrm(i) = Cells(i, 1).Value
       temp = creationFichier(coefSA, Cells(i, 1).Value, repertoireE, nomFichier & "_" & i)
    Next
 
    'valeur qu on renvoie
    arrayIdPrm = tableauIdPrm
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
'verifie que ca marche
Sub verif()
myarray = arrayIdPrm()
'Boucle sur les éléments du tableau
    For j = 1 To UBound(myarray)
        MsgBox myarray(j)
    Next j
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'Fonction appelée une fois qu'on a cliqué sur le bouton
Sub debutFonction()
Dim j As Long
 
 
Application.DisplayAlerts = False
 
If Range("B6") = "" Then
    MsgBox ("Veuillez Choisir un fichier")
   Exit Sub
End If
If Range("B7") = "" Then
    MsgBox ("Veuillez choisir un répertoire")
    Exit Sub
End If
If Range("B8") = "" Then
    MsgBox ("Veuillez saisir Pas Courbe svp")
    Exit Sub
End If
If Range("B9") = "" Then
    MsgBox ("Veuillez saisir un nom de fichier svp")
   Exit Sub
End If
'récupération des valeurs contenues dans la feuille 1
If (recuperationCOEFSA()) Then
    coefSA = recuperationCOEFSA()
Else
    Exit Sub
End If
 
 
cheminIdPrm = recuperationidPRM()
nomFichier = recuperationFichier()
repertoireE = repertoireEnregistrement()
 
'on copie le tableau d'idPRM sur la feuille 2 et on prend les différentes valeurs qu'on met dans le tableau tableauIdPrm
copieFichierIDPRM (cheminIdPrm)
tableauIdPrm = arrayIdPrm(coefSA, repertoireE, nomFichier)
 
'on crée le fichier xml
For j = 1 To UBound(tableauIdPrm)
temp = creationFichier(coefSA, tableauIdPrm(j), repertoireE, nomFichier & "_" & j)
Next
 
 
 
'on indique que le fichier est prêt
Sheets("Feuil1").Select
 
MsgBox "Le fichier est terminé"
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Bouton7_Clic()
 
 
FileToOpen = Application.GetOpenFilename("Fichiers Excel(*.xlsx), *.xlsx", , "Choisir le fichier à ouvrir")
If FileToOpen = False Then
MsgBox "Operation annulée", vbExclamation
Exit Sub
End If
 
Workbooks.Open FileToOpen
 
Workbooks("CreationFichierSC03_V2.xlsm").Activate
 
Range("B6").Select
Selection.Value = FileToOpen
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Bouton9_Clic()
 
   Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
 
    Range("B7").Select
    Selection.Value = Chemin
End Sub

Merci