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

Le 01/06/2020 à 15:39

Bonjour,

Je suis encore débutante dans VBA, j'aimerai bien une petite aide.

Je n'arrive pas à comprendre ce qui ne va pas dans mon code, quand j'essaye de le mettre en marche il y a le message d'erreur "l'indice n'appartient pas à la sélection" qui apparaît.

Voici mon code :

Option Explicit
Option Base 1

Type prestataire
  Société As String
  Agence As String
  Site_de_Maintenance As String
  téléphone As String
  Date_agrément As Single
End Type

Dim tab_mois(12) As String
Dim tab_prestataire() As prestataire
Dim init As Worksheet
Dim attestation As Worksheet
Dim gestion As Worksheet
Dim data As Worksheet

Public Sub charger_mois()
Dim i As Single

Set init = ThisWorkbook.Sheets("INIT_BASE")

For i = 1 To 12
  tab_mois(i) = init.Cells(14 + i, 1).Value
Next i
End Sub

Public Sub charger_prestataires()
Dim run As Single
Dim presta As prestataire

Set init = ThisWorkbook.Sheets("INIT_BASE")
run = 5

While IsEmpty(init.Cells(run, 1).Value) = False
  With presta
    .Société = init.Cells(run, 1).Value
    .Agence = init.Cells(run, 2).Value
    .Site_de_Maintenance = init.Cells(run, 3).Value
    .téléphone = init.Cells(run, 4).Value
    .Date_agrément = init.Cells(run, 5).Value
  End With

  ReDim Preserve tab_prestataire(run - 4)

  tab_prestataire(run - 4) = presta
  run = run + 1

Wend
End Sub

Public Sub traitement()

Dim isociete As Single
Dim nsheets As Single
Dim snbrun As Single
Dim srun As Worksheet
Dim nvoid As Single
Dim rrun As Single
Dim crun As Single
Dim nbplanif As Single
Dim acherche As String
Dim rreport As Single
Dim rannule As Single
Dim dat As Single
Dim dure As Single
Dim rrundat As Single
Dim name As String
Dim tannule As Single
Dim treport As Single

Set attestation = ThisWorkbook.Sheets(3)
Set gestion = ThisWorkbook.Sheets(2)
Set data = ThisWorkbook.Sheets(5)

Call charger_mois
Call charger_prestataires

isociete = gestion.Cells(2, 5).Value
attestation.Cells(6, 2).Value = tab_prestataire(isociete).Société
attestation.Cells(11, 2).Value = tab_mois(gestion.Cells(5, 5).Value)

nsheets = Worksheets.Count
nbplanif = 0
rreport = 33
rannule = 18
treport = 0
tannule = 0

For snbrun = 1 To nsheets
    rrun = 2
    nvoid = 0
    name = Mid(ThisWorkbook.Sheets(snbrun).name, 1, 7)

    'pour gérer les problèmes de nom dont vous m'avez parlé :
    If name = "Fiche_s" Then

      While nvoid < 41
      rrun = rrun + 1

      Set srun = ThisWorkbook.Sheets(snbrun)

      If IsEmpty(srun.Cells(rrun, isociete + 4)) = False Then
        nvoid = 0

       dat = srun.Cells(rrun, 1).Value
        rrundat = rrun

        While dat = 0
          rrundat = rrundat - 1
          dat = srun.Cells(rrundat, 1).Value
        Wend

        If Month(dat) = gestion.Cells(5, 5).Value Then
          dure = srun.Cells(rrun, 3).Value
          nbplanif = nbplanif + Hour(dure)

          If srun.Cells(rrun, isociete + 4).Value = 0 Then
            rreport = rreport + 1
            treport = treport + Hour(dure)
            attestation.Cells(rreport, 5).Value = dure
            acherche = Mid(srun.Cells(rrun, 4).Value, 1, 5)
            attestation.Cells(rreport, 3).Value = WorksheetFunction.VLookup(acherche, data.Range("A1:B9"), 2)
            attestation.Cells(rreport, 2).Value = dat

            If dat < tab_prestataire(isociete).Date_agrément Then
              attestation.Cells(rreport, 2) = "hors contrat"
              attestation.Range(attestation.Cells(rreport, 2), attestation.Cells(rreport, 5)).Font.ColorIndex = 48

            Else
              attestation.Range(attestation.Cells(rreport, 2), attestation.Cells(rreport, 5)).Font.ColorIndex = 1
            End If

          End If

          If srun.Cells(rrun, isociete + 4).Value = -1 Then
            rannule = rannule + 1
            tannule = tannule + Hour(dure)
            attestation.Cells(rannule, 5).Value = dure
            acherche = Mid(srun.Cells(rrun, 4).Value, 1, 5)
            attestation.Cells(rannule, 3).Value = WorksheetFunction.VLookup(acherche, data.Range("A1:B9"), 2)
            attestation.Cells(rannule, 2).Value = dat            

            If dat < tab_prestataire(isociete).Date_agrément Then
              attestation.Cells(rannule, 2) = "hors contrat"
              attestation.Range(attestation.Cells(rannule, 2), attestation.Cells(rannule, 5)).Font.ColorIndex = 48

            Else
              attestation.Range(attestation.Cells(rannule, 2), attestation.Cells(rannule, 5)).Font.ColorIndex = 1

            End If

          End If

        End If

      Else
        nvoid = nvoid + 1

      End If

      If rannule > 31 Or rreport > 46 Then
        MsgBox ("Plus de tâches ont été reportées ou non éxécutées qu'il n'y a de place sur cette attestation. Votre attestation est donc incomplète.")
        Exit For
      End If

      Wend

    End If

Next snbrun

attestation.Cells(53, 4).Value = Now()
attestation.Cells(32, 1).Value = treport
attestation.Cells(17, 1).Value = tannule
attestation.Cells(50, 5).Value = nbplanif
attestation.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & tab_prestataire(isociete).Société & "_" & attestation.Cells(11, 4).Value & "_" & tab_mois(gestion.Cells(5, 5).Value), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False

'reset de la feuille (non demandé, mais utile)'
attestation.Range("B19", "E31").ClearContents
attestation.Range("B34", "E46").ClearContents
attestation.Range("E50").ClearContents
attestation.Range("A17").Value = 0
attestation.Range("A32").Value = 0

End Sub

C'est les lignes "attestation.Cells(6, 2).Value = tab_prestataire(isociete).Société

attestation.Cells(11, 2).Value = tab_mois(gestion.Cells(5, 5).Value)" qui me posent problème mais je ne comprends pas pourquoi.

Le message affiché est "Erreur 9 L'indice n'appartient pas à la sélection"

Quelqu'un saurait pourquoi et pourrait me dire comment régler ce problème ?

Merci d'avance.

Le 01/06/2020 à 15:41

le fichier, cela sera plus simple

Merci

Le 01/06/2020 à 15:49

Merci pour votre réponse aussi rapide. Voici mon fichier :

4l3stenv-informatiqueappliquee-projet3.xlsm (90.54 Ko)
Le 01/06/2020 à 16:20

Bonjour,

Set gestion = ThisWorkbook.Sheets(2)

isociete = gestion.Cells(2, 5).Value

Or, gestion.Cells(2, 5) est vide ...

Un pas à pas (touche F8) > c'est bien utile ...

ric

Le 01/06/2020 à 16:48

Bonjour,

Affectivement je vois le problème. Mais par quoi devrais-je remplacer pour que ça marche ?

Le 01/06/2020 à 17:23

Bonjour,

isociete devrait être quelle information ?

Où est cette information ?

ric

Rechercher des sujets similaires à "indice appartient pas selection"