L'indice n'appartient pas à la sélection
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 fichier, cela sera plus simple
Merci
Merci pour votre réponse aussi rapide. Voici mon fichier :
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
Bonjour,
Affectivement je vois le problème. Mais par quoi devrais-je remplacer pour que ça marche ?
Bonjour,
isociete
devrait être quelle information ?
Où est cette information ?
ric