L'indice n'appartient pas à la sélection

L'indice n'appartient pas à la sélection - VB/VBA/VBS - Programmation

Marsh Posté le 08-09-2005 à 10:24:42    

Bonjour,
 
Ma macro a pour but de récuperer diverses informations d'une feuille pour les afficher differement dans une autre.
La première boucle se charge de récuperer et d'ouvrir les differents fichiers Excel.
La deuxième s'occupe des differents onglets.
La troisième traite des informations contenu dans un tableau.
 
A l'execution de la macro, le premier cycle (MList = Juin) s'effectue correctement mais au deuxième il m'affiche une erreur (L'indice n'appartient pas à la sélection)
 
Il semblerait avoir un problème du côté de la deuxième boucle ou peut être du tableau ArrayData mais je ne comprends pas du tout.
Au débuggeur, Excel me surligne >> ArrayData = ActiveWorkbook.Sheets(MList(j)).Range("E56:F61" )
 
Voici la macro en question :
 

Citation :


Sub CUMUL()
'
'
Dim VList As Variant
Dim MList As Variant
Dim LList As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim cpt As Integer
Dim Jours As Double
Jours = 0
Dim AVV As Double
AVV = 0
Dim ArrayData As Variant
Dim MyArray
 
'TABLEAU DES PERSONNES CONCERNEES
'VList = Array("BCR", "DDE", "FVD", "FTT" )
VList = Array("LPQ" )
 
'TABLEAU DES MOIS
MList = Array("Juin", "Juillet" )
 
'TABLEAU DES CASES
LList = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M" )
 
For i = LBound(VList) To UBound(VList)
 
Workbooks.Open Filename:=ActiveWorkbook.Path & "\Fiche de saisie des temps " & VList(i) & " 2005.xls"
 
    For j = LBound(MList) To UBound(MList)
 
    'MsgBox (j & " / " & LBound(MList) & " / " & MList(j) & " / " & LList(j))
     
    'Définition de chaque tableau par type de données
    ArrayData = ActiveWorkbook.Sheets(MList(j)).Range("E56:F61" )
     
    AVV = Round(ActiveWorkbook.Sheets(MList(j)).Application.WorksheetFunction.Sum(Range("D28:D31" )), 2)
     
    'MsgBox (MList & " / " & AVV)
     
    'Dimensionner ArrayResultat
    ReDim ArrayResultat(1 To UBound(ArrayData, 1))
     
        'Remplir Tableau
        For k = LBound(ArrayData, 1) To UBound(ArrayData, 1)
         
        If (IsEmpty(ArrayData(k, 1)) = False) Then
            cpt = cpt + 1
            'AFFAIRES
            Affaire = Affaire & ArrayData(k, 2) & Chr(10)
            'JOURS FACTURES
            Jours = Jours + Round(ArrayData(k, 1), 2)
        End If
         
        Next k
     
    Windows("cumul.xls" ).Activate
    Sheets("Feuil2" ).Range(LList(j) & "3" ).Value = Affaire
    Sheets("Feuil2" ).Range(LList(j) & "4" ).Value = Jours
    Sheets("Feuil2" ).Range(LList(j) & "5" ).Value = AVV
     
    Next
 
'Windows(ActiveWorkbook.Path & "\Fiche de saisie des temps " & VList(i) & " 2005.xls" ).Activate
'ActiveWorkbook.Save
'ActiveWindow.Close
 
Next i
 
End Sub


 
Merci par avance de votre éventuelle aide :)

Reply

Marsh Posté le 08-09-2005 à 10:24:42   

Reply

Marsh Posté le 08-09-2005 à 10:47:53    

Bonjour,
rapidos ! j'ai l'impression que tu changes de classeur actif dans la boucle k
il faudrait remplacer :
    Windows("cumul.xls" ).Activate
    Sheets("Feuil2" ).Range(LList(j) & "3" ).Value = Affaire
    Sheets("Feuil2" ).Range(LList(j) & "4" ).Value = Jours
    Sheets("Feuil2" ).Range(LList(j) & "5" ).Value = AVV  
par :

Code :
  1. With Workbooks("cumul.xls" ).Sheets("Feuil2" )
  2. .Range(LList(j) & "3" ).Value = Affaire
  3. .Range(LList(j) & "4" ).Value = Jours
  4. .Range(LList(j) & "5" ).Value = AVV
  5. End With

Si j'ai bien vu...
A+


---------------
roger
Reply

Marsh Posté le 08-09-2005 à 11:44:24    

Tout d'abord, merci :)
Apparement, c'était à cet endroit que ça déconnait...
 
Cepedant quand je mets :

Citation :


With Workbooks("cumul.xls" ).Sheets("Feuil2" )
        Sheets("Feuil2" ).Range(LList(j) & "3" ).Value = Affaire
        Sheets("Feuil2" ).Range(LList(j) & "4" ).Value = Jours
        Sheets("Feuil2" ).Range(LList(j) & "5" ).Value = AVV
End With


 
Ca me fait la même erreur.
 
Et avec ça :

Citation :


    With Workbooks("cumul.xls" ).Sheets("Feuil2" )
        Range(LList(j) & "3" ).Value = Affaire
        Range(LList(j) & "4" ).Value = Jours
        Range(LList(j) & "5" ).Value = AVV
    End With


 
Il ne me remplit pas les cases :(

Reply

Marsh Posté le 08-09-2005 à 11:55:15    

Re:
ça sert à quoi que galopin y se décarcasse ?
 
Tu sélectionnes le texte du code que je t'ai mis et...
Tu fais un Copier / Coller
 
Ok ?


---------------
roger
Reply

Marsh Posté le 08-09-2005 à 11:58:40    

Super ça fonctionne !!!!
Désolé pour le copié/collé... J'avais pas fait gaffe aux "."
 
Merci !!!!!

Reply

Marsh Posté le 09-09-2005 à 17:18:41    

Autre petit problème... (peut être que ca sera simple mais je ne suis vraiment pas calé en VBA Excel)
 

Citation :


Sub CUMUL()
'
' CUMUL Macro
'
Dim VList As Variant
Dim MList As Variant
Dim LList As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim cpt As Integer
cpt = 3
Dim Jours As Double
Jours = 0
Dim AVV As Double
Dim FI As Double
Dim MPG As Double
Dim RD As Double
Dim IC As Double
Dim DE As Double
Dim AB As Double
Dim RE As Double
Dim ArrayData As Variant
 
'TABLEAU DES PERSONNES CONCERNEES
'VList = Array("BCR", "DDE", "FVD", "FTT" )
VList = Array("LPQ" )
 
'TABLEAU DES MOIS
MList = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet" )
 
'TABLEAU DES CASES
LList = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M" )
 
For i = LBound(VList) To UBound(VList)
 
Workbooks.Open Filename:=ActiveWorkbook.Path & "\Fiche de saisie des temps " & VList(i) & " 2005.xls"
 
    For j = LBound(MList) To UBound(MList)
   
    'Définition de chaque tableau par type de données
    ArrayData = ActiveWorkbook.Sheets(MList(j)).Range("E56:F61" )
     
    'Affaire = 0
    Jours = 0
    AVV = 0
    FI = 0
    MPG = 0
    RD = 0
    IC = 0
    DE = 0
    AB = 0
    RE = 0
     
    Set mySheet = ActiveWorkbook.Sheets(MList(j))
     
    MsgBox (mySheet.Name)
     
    AVV = mySheet.Application.WorksheetFunction.Sum(Range("D28:D31" ))
    FI = mySheet.Range("D32" )
    MPG = mySheet.Application.WorksheetFunction.Sum(Range("D33:D35" ))
    RD = mySheet.Application.WorksheetFunction.Sum(Range("D36:D38" ))
    IC = mySheet.Range("D39" )
    DE = mySheet.Range("D40" )
    AB = mySheet.Application.WorksheetFunction.Sum(Range("D41:D47" ))
    RE = mySheet.Range("D48" )
     
    'Dimensionner ArrayResultat
    ReDim ArrayResultat(1 To UBound(ArrayData, 1))
     
        'Remplir Tableau
        For k = LBound(ArrayData, 1) To UBound(ArrayData, 1)
         
        If (IsEmpty(ArrayData(k, 1)) = False) Then
            'AFFAIRES
            'Affaire = Affaire & ArrayData(k, 2) & Chr(10)
            'JOURS FACTURES
            Jours = Jours + Round(ArrayData(k, 1), 2)
        End If
         
        Next k
     
 
    'MsgBox (LList(j) & cpt + 7 & "=" & AB)
     
    With Workbooks("cumul.xls" ).Sheets("Feuil2" )
        .Range("A2" ).Value = VList(i)
        '.Range(LList(j) & "3" ).Value = Affaire
        .Range(LList(j) & cpt).Value = Jours
        .Range(LList(j) & cpt + 1).Value = AVV
        .Range(LList(j) & cpt + 2).Value = FI
        .Range(LList(j) & cpt + 3).Value = MPG
        .Range(LList(j) & cpt + 4).Value = RD
        .Range(LList(j) & cpt + 5).Value = IC
        .Range(LList(j) & cpt + 6).Value = DE
        .Range(LList(j) & cpt + 7).Value = AB
        .Range(LList(j) & cpt + 8).Value = RE
    End With
     
    Next j
 
'AJOUT DE LIGNES VIDES
'With Workbooks("cumul.xls" ).Sheets("Feuil2" )
'    Range("A" & cpt + 14 & ":N" & cpt + 15).Select
'    With Selection.Interior
'        .ColorIndex = 2
'        .Pattern = xlSolid
'    End With
'End With
 
'INCREMENTATION DE CPT
cpt = cpt + 17
 
ActiveWorkbook.Save
ActiveWindow.Close
 
Next i
 
End Sub


 
Il semblerait que les variablesAVV, FI, MPG, RD, IC, DE, AB, RE une fois initialisées conservent leur valeur tout le long de l'execution de la macro. Ce qui fait que j'ai les memes valeurs partout dans mon tableau final.
 
Merci encore pour votre aide éventuelle.

Reply

Marsh Posté le 09-09-2005 à 17:22:47    

Bon, j'ai trouvé...
J'avais oublié mySheet.Activate pour que la sélection se fasse correctement.
 

Reply

Marsh Posté le 22-11-2007 à 17:13:24    

Bonjour à tous,
Je n'y connais pas grand choses en VBA et j'ai le même message d'erreur, pouriez vous peut etre m'aider ?
Si vous avez besoin du reste du code n'hésitez pas.
 
Voici le code de la fonction ajout client:
 
Dim nom As String
Dim code As String
Dim typ As String
Dim famille As String
Dim ville As String
Dim nombre As Integer
Dim num As Integer
Dim TrouveType As Boolean
Dim TrouveFam As Boolean
Dim nb As Integer
 
Sub CommandButton1_Click()
 
nombre = nbligne
TrouveType = False
TouveFam = False
nb = 0
 
If nomc = "" Then
    rep = MsgBox("Veuillez saisir le nom !", vbOKOnly, "Attention" )
    nomc.SetFocus
    Exit Sub
End If
 
If villec = "" Then
    rep = MsgBox("Veuillez saisir la ville !", vbOKOnly, "Attention" )
    villec.SetFocus
    Exit Sub
End If
 
If codec = "" Then
    rep = MsgBox("Veuillez saisir le code !", vbOKOnly, "Attention" )
    codec.SetFocus
    Exit Sub
End If
 
If typec = "" Then
    rep = MsgBox("Veuillez saisir le type !", vbOKOnly, "Attention" )
    typec.SetFocus
    Exit Sub
End If
 
If famillec = "" Then
    rep = MsgBox("Veuillez saisir la famille !", vbOKOnly, "Attention" )
    famillec.SetFocus
    Exit Sub
End If
 
nom = Format(nomc, ">" )
code = Format(codec, ">" )
typ = Format(typec, ">" )
famille = Format(famillec, ">" )
ville = villec
For i = 12 To nombre
    If Cells(i, 2).Value = "Total External Sales" Then
        num = i
    End If
    If Cells(i, 6).Value = typ Then
        TrouveType = True
    End If
    If Cells(i, 2).Value = famille Then
        TrouveFam = True
        nb = nb + 1
    End If
Next i
 
If TrouveType = False Then
    rep = MsgBox("Le type " & typ & " n'existe pas !", vbOKOnly, "Attention" )
    typec.SetFocus
    Exit Sub
End If
 
If TrouveFam = False Then
    rep = MsgBox("La famille " & famille & " n'existe pas !", vbOKOnly, "Attention" )
    famillec.SetFocus
    Exit Sub
End If
 
For index = 3 To 14
    ActiveWorkbook.Worksheets(index).Activate
    For i = 12 To nombre
        If Cells(i, 6).Value = typ Then
            If Cells(i, 2).Value = famille Then
                Rows(i + 1 & ":" & i + 1).Select
                Selection.Insert Shift:=xlDown  'insertion d une ligne
                Cells(i + 1, 2).Value = famille
                Cells(i + 1, 3).Value = ville
                Cells(i + 1, 4).Value = code
                Cells(i + 1, 5).Value = nom
                Cells(i + 1, 6).Value = typ
 
                Range(Cells(i, 8), Cells(i, 20)).Select
                Selection.Copy
 
                Range(Cells(i + 1, 8), Cells(i + 1, 8)).Select
                Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
                    False, Transpose:=False
                Cells(i + 1, 10).Value = ""
 
                Cells(i + 1, 12).Value = ""
                Cells(i + 1, 14).Value = ""
                Cells(i + 1, 17).Value = ""
                Cells(i + 1, 18).Value = ""
                Cells(i + 1, 19).Value = ""
 
                Exit For
            End If
        End If
    Next i
 
    If nb = 1 Then 'cas ou il y avait 1 client dans la famille
 
        Rows(i + 2 & ":" & i + 2).Select
        Cells(i + 2, 7).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
        Cells(i + 2, 8).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
        Cells(i + 2, 10).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
        Cells(i + 2, 19).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
 
        Cells(i + 2, 12).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)+RC[5]"
        Cells(i + 2, 14).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)+RC[4]"
        Cells(i + 2, 17).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
        Cells(i + 2, 18).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
 
    End If
 
    Range("A1" ).Select
 
Next index
 
Dim XLFichier As Workbook
 
Set XLFichier = Workbooks.Open("\\ttfrvilfs01\travail\Commerci\Previsions\Roller\Forecast 2006\Sales YTD.xls" )
XLFichier.Worksheets(1).Activate
For i = 12 To nombre
    If Cells(i, 6).Value = typ Then
        If Cells(i, 2).Value = famille Then
            Rows(i + 1 & ":" & i + 1).Select
            Selection.Insert Shift:=xlDown  'insertion d une ligne
            Cells(i + 1, 2).Value = famille
            Cells(i + 1, 3).Value = ville
            Cells(i + 1, 4).Value = code
            Cells(i + 1, 5).Value = nom
            Cells(i + 1, 6).Value = typ
 
            Range(Cells(i, 8), Cells(i, 20)).Select
            Selection.Copy
 
            Range(Cells(i + 1, 8), Cells(i + 1, 8)).Select
            Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
            Cells(i + 1, 7).Value = ""
 
            Cells(i + 1, 10).Value = ""
            Cells(i + 1, 12).Value = ""
            Cells(i + 1, 14).Value = ""
            Cells(i + 1, 17).Value = ""
            Cells(i + 1, 18).Value = ""
            Cells(i + 1, 19).Value = ""
 
            Exit For
        End If
    End If
Next i
 
If nb = 1 Then 'cas ou il y avait 1 client dans la famille
 
    Rows(i + 2 & ":" & i + 2).Select
    Cells(i + 2, 7).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
    Cells(i + 2, 8).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
    Cells(i + 2, 10).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
    Cells(i + 2, 19).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
    Cells(i + 2, 12).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)+RC[5]"
    Cells(i + 2, 14).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)+RC[4]"
    Cells(i + 2, 17).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
    Cells(i + 2, 18).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
 
End If
 
Range("A1" ).Select
XLFichier.Save
XLFichier.Close
Set XLFichier = Nothing
 
Application.ActiveWorkbook.Save
SaisieClient.Hide
Unload SaisieClient
 
End Sub
Sub CommandButton2_Click()
 
SaisieClient.Hide
Unload SaisieClient
Range("a1" ).Select
 
End Sub
 
 
Lorsque  je click sur debuger ca me renvoie a cette ligne de code:
 
For index = 3 To 14
   ActiveWorkbook.Worksheets(index).Activate    For i = 12 To nombre
        If Cells(i, 6).Value = typ Then
            If Cells(i, 2).Value = famille Then
                Rows(i + 1 & ":" & i + 1).Select
                Selection.Insert Shift:=xlDown  'insertion d une ligne
                Cells(i + 1, 2).Value = famille
                Cells(i + 1, 3).Value = ville
                Cells(i + 1, 4).Value = code
                Cells(i + 1, 5).Value = nom
                Cells(i + 1, 6).Value = typ
 
                Range(Cells(i, 8), Cells(i, 20)).Select
                Selection.Copy
 
                Range(Cells(i + 1, 8), Cells(i + 1, 8)).Select
                Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
                    False, Transpose:=False
                Cells(i + 1, 10).Value = ""
 
                Cells(i + 1, 12).Value = ""
                Cells(i + 1, 14).Value = ""
                Cells(i + 1, 17).Value = ""
                Cells(i + 1, 18).Value = ""
                Cells(i + 1, 19).Value = ""
 
                Exit For
            End If
        End If
    Next i


Message édité par dudul71 le 22-11-2007 à 17:21:00
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed