Aide code VBA

Le 12/03/2013 à 16:48

Bonjour,

Voici mon code:

Sub ChargesIncidents()

'Initilise la liste des fiches pertinentes

    Worksheets("ListeFiche").Activate
    i = 2
    While Cells(i, 1).Value <> ""
        i = i + 1
    Wend
    ReDim ListFiche(i - 2)

    i = 0
    While Cells(i + 2, 1).Value <> ""
        ListFiche(i) = Cells(i + 2, 1).Value
        i = i + 1
    Wend

'Initilise le tableau des personnes en astreinte

    Worksheets("Astreinte").Activate
    i = 2
    While Cells(i, 1).Value <> ""
        i = i + 1
    Wend
    ReDim ListAstreinte(i - 2, 57)
    DimAstreinte = i - 2

    i = 0
    J = 0
    While Cells(i + 2, 1).Value <> ""
        For J = 0 To 56
            ListAstreinte(i, J) = Cells(i + 2, J + 1).Value
        Next J
        i = i + 1
    Wend

'Boucle principale

    Worksheets("Export").Activate
    i = 2

    While Cells(i, 1).Value <> ""
        NumFiche = Range("T" & i).Value
        Struc_Util = Range("I" & i).Value
        Nom = Range("K" & i).Value
        NbHeure = Range("P" & i).Value
        semaine = Range("G" & i).Value
        login = Range("J" & i).Value

        If FichePertinente(NumFiche) Then
            Numligne = TestStructure(Struc_Util)
            Select Case Numligne
            Case 1, 2, 3, 4
                PermR2(Numligne, semaine) = PermR2(Numligne, semaine) + NbHeure
            Case 5, 6, 7, 8, 9, 10
                PermR2(Numligne, semaine) = PermR2(Numligne, semaine) + NbHeure

   R2 = ValeurAstreinte(Login, Semaine)
                If R2 = 1 Then
                    PermR2(Numligne, Semaine) = PermR2(Numligne, Semaine) + NbHeure
                    Else
                        If NbHeure > 8 Then

                            Ajustifier = "Oui"
                            Else
                            Ajustifier = "Non"

                        End If
                        Worksheets("HorsPermR2").Activate
                        Call HorsPermR2(Struc_Util, Login, Nom, Prénom, Semaine, NbHeure, Ajustifier)
                        Worksheets("Export").Activate
            End Select

        End If

        i = i + 1

    Wend

End Sub

Voici une des fonctions;

Function ValeurAstreinte(Login, Semaine) As Integer

    ValeurAstreinte = 0

        For i = 0 To DimAstreinte

         If Login = ListAstreinte(i, 1) Then ValeurAstreinte = ListAstreinte(i, Semaine + 6)

    Next i

End Function

La partie du code qui commence avec la variable R2 ne fonctionne pas. Je viens de débuter le VBA et malgré mes recherches, je ne trouve pas l'erreur.

Pouvez vous m'aiguiller.

Cdt,

Le 12/03/2013 à 17:05

Bonjour,

il faudrait passer dimastreinte en paramètre à ta fonction, et elle ne connait pas non plus ListAstreinte.

A moins que tu ne les aies déclarées au niveau module ? On ne voit aucune déclaration...

Et si elle n'est appelée qu'une fois est-ce intéressant d'en faire une fonction ?

eric

Le 12/03/2013 à 17:47

Bonjour,

Merci de votre réponse,

J'ai essayé d'ajouter le paramètre, mais celà ne fonctionne tjrs pas.

D'ailleurs, dans mon onglet synthèse

Voici tout le code

Et ci-joint le fichier

Private ListFiche() As String
Private PermR2(11, 54) As Variant
Private ListAstreinte() As Variant
Private DimAstreinte As Integer
Private IndexHorsPerm As Integer

Function FichePertinente(Num) As Boolean
    FichePertinente = False
    For i = 0 To 20
        If Num = ListFiche(i) Then FichePertinente = True
    Next i
End Function
Function TestStructure(Struc) As Integer
    TestStructure = 0
    Select Case Struc
    Case "TEST/RES/DOR/OCR/SN1/Accès"
        TestStructure = 1
    Case "TEST/RES/DOR/OCR/SN1/Transport"
        TestStructure = 2
    Case "TEST/RES/DOR/OCR/SN1/Coeur"
        TestStructure = 3
    Case "TEST/RES/DOR/OCR/SN1/PFs"
        TestStructure = 4
    Case "TEST/RES/DOR/OSD/PDC", "TEST/RES/DOR/OSD/SDC"
        TestStructure = 9
    Case "TEST/RES/DOR/OSD/PCI", "TEST/RES/DOR/OSD/SIP", "TEST/RES/DOR/OSD/PMI"
        TestStructure = 10
    End Select

    StrucShort = Left(Struc, 28)
    Select Case StrucShort
    Case "TEST/RES/DOR/OPR"
        TestStructure = 5
    Case "TEST/RES/DOR/OPT"
        TestStructure = 6
    Case "TEST/RES/DOR/OPC"
        TestStructure = 7
    Case "TEST/RES/DOR/SPS"
        TestStructure = 8
    End Select

End Function

Function ValeurAstreinte(Login, Semaine) As Integer

    ValeurAstreinte = 0

        For i = 0 To DimAstreinte

         If Login = ListAstreinte(i, 1) Then ValeurAstreinte = ListAstreinte(i, Semaine + 6)

    Next i

End Function

Sub HorsPermR2(Structure, Login, Nom, Prénom, Semaine, NbHeure, Ajustifier)

    Cells(IndexHorsPerm, 1) = Structure
    Cells(IndexHorsPerm, 2) = Login
    Cells(IndexHorsPerm, 3) = Nom
    Cells(IndexHorsPerm, 4) = Prénom
    Cells(IndexHorsPerm, 5) = Semaine
    Cells(IndexHorsPerm, 6) = NbHeure
    Cells(IndexHorsPerm, 7) = Ajustifier

    IndexHorsPerm = IndexHorsPerm + 1

End Sub

Sub EditSynthèse()

    Worksheets("Synthèse").Activate
    i = 0
    J = 0
    For i = 0 To 10
        For J = 0 To 53
            Cells(i + 1, J + 1) = PermR2(i, J)

        Next J
    Next i

End Sub

Sub ChargesIncidents()

IndexHorsPerm = 2

'Initialise le tableau de Permanence

    J = 1
    For J = 1 To 53
        PermR2(0, J) = "S" & J
        For i = 1 To 11
            PermR2(i, J) = 0
        Next i
    Next J
    PermR2(1, 0) = "SN1 Accès"
    PermR2(2, 0) = "SN1 Transport"
    PermR2(3, 0) = "SN1 Coeur"
    PermR2(4, 0) = "SN1 PFS"
    PermR2(5, 0) = "SN2 OPR"
    PermR2(6, 0) = "SN2 OPT"
    PermR2(7, 0) = "SN2 OPC"
    PermR2(8, 0) = "SN2 SPS"
    PermR2(9, 0) = "SN2 OSD - Coeur Data"
    PermR2(10, 0) = "SN2 OSD - Coeur IP"

'Initilise la liste des fiches pertinentes

    Worksheets("ListeFiche").Activate
    i = 2
    While Cells(i, 1).Value <> ""
        i = i + 1
    Wend
    ReDim ListFiche(i - 2)

    i = 0
    While Cells(i + 2, 1).Value <> ""
        ListFiche(i) = Cells(i + 2, 1).Value
        i = i + 1
    Wend

'Initilise le tableau des personnes en astreinte

    Worksheets("Astreinte").Activate
    i = 2
    While Cells(i, 1).Value <> ""
        i = i + 1
    Wend
    ReDim ListAstreinte(i - 2, 57)
    DimAstreinte = i - 2

    i = 0
    J = 0
    While Cells(i + 2, 1).Value <> ""
        For J = 0 To 56
            ListAstreinte(i, J) = Cells(i + 2, J + 1).Value
        Next J
        i = i + 1
    Wend

'Boucle principale

    Worksheets("Export").Activate
    i = 2

    Affiche = 0
    While Cells(i, 1).Value <> ""
        NumFiche = Range("T" & i).Value
        Struc_Util = Range("I" & i).Value
        Nom = Range("K" & i).Value
        NbHeure = Range("P" & i).Value
        Semaine = Range("G" & i).Value
        Login = Range("J" & i).Value
        Prénom = Range("L" & i).Value

        If FichePertinente(NumFiche) Then
            Numligne = TestStructure(Struc_Util)
            Select Case Numligne
            Case 1, 2, 3, 4
                PermR2(Numligne, Semaine) = PermR2(Numligne, Semaine) + NbHeure
            Case 5, 6, 7, 8, 9, 10
                    PermR2(Numligne, Semaine) = PermR2(Numligne, Semaine) + NbHeure
           End Select

            End If

                R2 = ValeurAstreinte(Login, Semaine)
                If R2 = 1 Then
                    PermR2(Numligne, Semaine) = PermR2(Numligne, Semaine) + NbHeure
                    Else
                        If NbHeure > 8 Then

                            Ajustifier = "Oui"
                            Else
                            Ajustifier = "Non"

'                        End If

                        Worksheets("HorsPermR2").Activate
                        Call HorsPermR2(Struc_Util, Login, Nom, Prénom, Semaine, NbHeure, Ajustifier)
                        Worksheets("Export").Activate

                End If
            End Select
        End If
        i = i + 1

    Wend
    EditSynthèse

End Sub

Voici la liste de mes différentes mes problèmes

Dans l'onglet synthèse, les ligne 5 à 10 ne se remplissent pas. Pourtant les ligne 1 à 5 se remplissent correctement avec les bonnes valeurs.

je souhaite dans l'onglet HorspermR2 les utilisateurs dont la valeurs est égale à 0 dans les coionnes S01, S02 de l'onglet Astreinte.

D'ailleurs, comment je peux réinitialiser les valeurs de l'onglet HorsPermR2 si je souhaite mettre un nouvel export dans l'onglet "Export" et comment remplacer l'ancien export pour copier un nouvel export et executer la macro?

NB: Par contre, j'ai du supprimer plus de 1000 ligne dans l'export pour vous joindre le fichier.

Merci

Le 12/03/2013 à 18:22

Une question à la fois, on va rester sur la 1ère si tu veux bien.

Déjà tu as un end select qui se balade tout seul, tu aurais pu l'enlever.

Ensuite Semaine = oui ou non.

Comment veux-tu que ta fonction marche avec ...Then ValeurAstreinte = ListAstreinte(i, Semaine + 6) ?

eric

Le 12/03/2013 à 18:30

Normalement, Semaine = 1 à X en fonction de l'export.

Je viens de mettre le fichier joint édité

Pour le end Select, je viens de le supprimer.

Le 12/03/2013 à 22:15

J'ai dû supprimer le end select...

Là, la fonction tourne et R2 prend sa valeur (mais c'est loin d'être la solution la plus rapide...)

Maintenant ça plante sur la ligne suivante car numligne n'est pas initialisé.

Il y a beaucoup trop d'erreur dans ton code, normalement on débogue au fur et à mesure sinon ça devient impossible.

Pour cette question tu peux mettre en résolu, démarre un autre fil pour les autres.

eric

Rechercher des sujets similaires à "aide code vba"