Parcourir un filtre auto VBA

Le 10/01/2017 à 15:23

Bonjour,

Je souhaite appliquer à une BDD un filtre sur une colonne afin de générer un graphique pour chaque valeur du filtre.

Pour illustrer mes propos, voici un extrait de base lambda avec une liste de salariés, je souhaiterais filtrer emploi par emploi et faire des courbes représentant l'évolution du salaire en fonction de l'âge par emploi. Dans cet extrait, nous devrions obtenir 2 graph un pour les ASSISTANTS un pour les RESPONSABLES.

Nom Prénom Région Emploi Age Salaire

DUPONT JULES NORD ASSISTANT 26 30000

MARIE LISE NORMANDIE RESPONSABLE 53 50000

ROBERT ALEXANDRE NORMANDIE ASSISTANTE 34 20000

DUBOSC MARION NORD RESPONSABLE 42 35000

DUBOURG MIREILLE BRETAGNE RESPONSABLE 30 40000

Je suis débutante, avez vous une méthode ou des conseils à me donner ?

Bien cordialement,

Le 10/10/2017 à 18:07

Bonjour,

Je cherche à faire une manipulation similaire.

Si vous avez trouvé une technique, je suis prenneur.

J'ai bien essayé de faire fonctionner le filtre suivant:

https://forum.excel-pratique.com/excel/utilisation-de-autofilter-en-vba-t35460.html

mais je n'arrive pas à filtrer sur tous les noms une seule fois

Analytiquement, le code reviendrait à serait:

1. Pour toute valeur unique EMPLOI de la colone G faire

2. Filtrer le document suivant la colone G avec le critère EMPLOI

3. impression pdf (ca, j'arrive à le faire!)

4. reinitialiser les filtres

5. Fin du pour

Le 10/10/2017 à 19:01

Bonjour,

Merci de joindre un fichier à ta demande.

Cdlt.

Le 10/10/2017 à 19:33

L’Idée serait de pouvoir filtrer chaque enseignant sur la colonne "ENSEIGNANT REFERANT" pour pouvoir lui créer son planning.

Je bloque sur le fait de pouvoir parcourir et filtrer cette colonne avec le nom de l'enseignant (et ne le faire qu'une fois par enseignant).

Je suis assez surpris d'avoir autant de mal de comprendre Excel/VBA alors que je peux coder dans d'autres langages plutôt aisément!

Je pourrai joindre la macro que j'ai écrite sur un autre post si vous le souhaiter (fin de travail aujourd'hui et macro très brouillonne)

25calendrierpourfiltres.xlsx (11.56 Ko)
Le 12/10/2017 à 14:48

Rebonjour,

J'ai réussi à faire une boucle sur les noms d'une colonne en utilisant les tableaux dynamiques et en me basant sur l'enregistrement d'une macro.

seulement, il arrive que le document .pdf n'affiche pas de lignes alors qu'il devrait.

J'ai ajouté le code qui suit mais cela ne semble pas suffire.

                'supposé temporiser pour s'assurer que le filtrage est terminé
                Do While Application.CalculationState <> xlDone
                     DoEvents
                Loop

Code complet:

Sub exportpdf()
'
' exportpdf Macro
'
' Touche de raccourci du clavier: Ctrl+j
'

Dim FL1 As Worksheet, Cell As Range, NoCol1 As Integer, NoCol2 As Long
Dim DerLig As Long, Plage As Range
'Les données récupérées
Dim Var1, Var2, Var3, adres As String, NoLig As Long, NoCol As Integer

    'selectionne l'onglet sur lequel on veut travailler
    Sheets("Récap jour total2").Select

    'creation du tbl dyn et qui va se mettre dans l'onglet NomsProfs
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Récap jour total2!R1C8:R1048576C8", Version:=xlPivotTableVersion15). _
        CreatePivotTable TableDestination:="NomsProfs!R1C1", TableName:= _
        "TableauNomsProfs", DefaultVersion:=xlPivotTableVersion15

    'selectionne de l'onglet NomsProfs (pour pouvoir travailler sur le tbl dyn
    Sheets("NomsProfs").Select
    'j imagine que cela permet de creer la liste des profs sans qu'ils soient dupliques
    With ActiveSheet.PivotTables("TableauNomsProfs").PivotFields( _
        "ENSEIGNANT REFERENT")
        .Orientation = xlRowField
        .Position = 1
    End With
    'ActiveSheet.PivotTables("TableauNomsProfs").AddDataField ActiveSheet. _
        PivotTables("TableauNomsProfs").PivotFields("ENSEIGNANT REFERENT"), _
        "Nombre de ENSEIGNANT REFERENT", xlCount

    'Instance de la feuille : Permet d'utiliser FL1 partout dans ...
    '... le code à la place de Worksheets("Feuil2")
    Set FL1 = Worksheets("NomsProfs")

    'Fixe le N° de première colonne de la plage à lire
    NoCol1 = 1

    'Fixe le N° de la dernière colonne de la plage à lire
    NoCol2 = 1

    'Détermine la dernière ligne renseignée de la feuille de calculs
    DerLig = Split(FL1.UsedRange.Address, "$")(4)

    'où FL1.Range(FL1.Cells(1, NoCol1), FL1.Cells(Derlig, NoCol2)) détermine
    'la plage de cellules à lire

    With FL1
        Set Plage = .Range(FL1.Cells(1, NoCol1), FL1.Cells(DerLig, NoCol2))
        'Utilisation de l'objet range (Cell) dans une boucle For Each... Next
        For Each Cell In Plage

            '*** Récupération des valeurs de plusieurs cellule ***
            'Valeur de la cellule lue et la "nettoie" de caracteres speciaux
            Var1 = Application.WorksheetFunction.Clean(Cell.Value)
            'Valeur de la cellule de la même ligne, colonne NoCol + 1
            Var2 = Cell.Offset(0, 1)
            'Valeur de la cellule de la même ligne, colonne NoCol + 2
            Var3 = Cell.Offset(0, 2)
            'Poursuivre si la variable est differente de "" "-" ou "0"
            If ((Var1 <> "") And (Var1 <> "-") And (Var1 <> "0") And (Var1 <> "Total général") And (Var1 <> "Étiquettes de lignes") And (Var1 <> "(vide)")) Then
                '*** Récupération de l'adresse de la cellule lue ***
                'Adresse complète
                adres = Cell.Address
                'Numéro de ligne
                NoLig = Cell.Row
                'Numéro de colonne
                NoCol = Cell.Column

                'Pour tester : Affiche les variables dans la fenêtre Exécution de VBA
                Debug.Print adres & " " & NoLig & " " & NoCol & " "
                Debug.Print Var1 & " " & Var2 & " " & Var3
                'ActiveSheet.PivotTables("TableauNomsProfs").PivotSelect "AGULLO", _
                    xlDataAndLabel + xlFirstRow, True

                'selectionne l onglet surlequel travailler
                Sheets("planning intervention").Select
                'annule tous les filtres sur le tableau (qu'il faudrait mettre en automatique)
                'idealement, il faudrait que les critere soient "tous" plutot que les annuler
                ActiveSheet.Range("$A$1:$M$18901").AutoFilter Field:=7

                'filtre sur Var1, qui contient le nom du prof
                ActiveSheet.Range("$A$1:$M$18901").AutoFilter Field:=7, Criteria1:= _
                    "=" & Var1, Operator:=xlAnd

                'supposé temporiser pour s'assurer que le filtrage est terminé
                Do While Application.CalculationState <> xlDone
                     DoEvents
                Loop

                'enregistre sous format pdf le resultat de l'application du filtre
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    "C:\Users\temp\CALENDRIER_" & Var1 & ".pdf" _
                    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                    :=False, OpenAfterPublish:=False

                'selectionne l onglet NomsProfs pour pouvoir poursuivre la selection dans le tbl dyn
                Sheets("NomsProfs").Select
                'Pour debug, permet d'eviter de faire tous les profs
                If (Var1 = "ANGELI") Then
                    Exit For
                End If
            End If
        Next
    End With
    Set FL1 = Nothing
    Set Plage = Nothing

End Sub
31calendrierpourfiltres.xlsm (868.62 Ko)
Le 17/10/2017 à 16:59

Toujours sur ce projet, je continue d'avoir le problème.

Lors de tests sur le fichier d'origine, outre la présentation, aucune ligne n'est inscrite pour le premier nom dans le fichier pdf alors que dans le fichier test que je souhaitais vous faire parvenir, (copie par valeur sans format -et non pas formules comme dans le fichier origine - de toutes les lignes) j'obtiens bien les lignes filtrées.

J'ai ajouté des MsgBox pour visualiser la feuille filtrée, qui apparait effectivement bien et que je pense devrait être copiée en pdf mais cela n' a rien changé: toujours rien dans le fichier pdf lors du premier (et certains autres) filtres.

Je ne peux malheureusement pas vous fournir le document .xlsm original du fait des informations qu'il contient.

Je suis prenneur si quelqu'un a une idée qui pourrait résoudre ce "bug".

Sub exportpdf()
'
' exportpdf Macro
'
' Touche de raccourci du clavier: Ctrl+j
'

Dim FL1 As Worksheet, Cell As Range, NoCol1 As Integer, NoCol2 As Long
Dim DerLig As Long, Plage As Range
'Les données récupérées
Dim Var1, Var2, Var3, adres As String, NoLig As Long, NoCol As Integer

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Récap jour total!R1C8:R1048576C8", Version:=xlPivotTableVersion15). _
        CreatePivotTable TableDestination:="NomsProfs!R1C1", TableName:= _
        "TableauNomsProfs", DefaultVersion:=xlPivotTableVersion15
    'Sheets("Feuil3").Select
    Sheets("NomsProfs").Select
    'Cells(3, 1).Select
    With ActiveSheet.PivotTables("TableauNomsProfs").PivotFields( _
        "ENSEIGNANT REFERENT")
        .Orientation = xlRowField
        .Position = 1
    End With
    'ActiveSheet.PivotTables("TableauNomsProfs").AddDataField ActiveSheet. _
        PivotTables("TableauNomsProfs").PivotFields("ENSEIGNANT REFERENT"), _
        "Nombre de ENSEIGNANT REFERENT", xlCount

    'Instance de la feuille : Permet d'utiliser FL1 partout dans ...
    '... le code à la place de Worksheets("Feuil2")
    Set FL1 = Worksheets("NomsProfs")

    'Fixe le N° de première colonne de la plage à lire
    NoCol1 = 1

    'Fixe le N° de la dernière colonne de la plage à lire
    NoCol2 = 1

    'Détermine la dernière ligne renseignée de la feuille de calculs
    DerLig = Split(FL1.UsedRange.Address, "$")(4)

    'où FL1.Range(FL1.Cells(1, NoCol1), FL1.Cells(Derlig, NoCol2)) détermine
    'la plage de cellules à lire

    With FL1
        Set Plage = .Range(FL1.Cells(1, NoCol1), FL1.Cells(DerLig, NoCol2))
        'Utilisation de l'objet range (Cell) dans une boucle For Each... Next
        For Each Cell In Plage

            '*** Récupération des valeurs de plusieurs cellule ***
            'Valeur de la cellule lue
            Var1 = Application.WorksheetFunction.Clean(Cell.Value)
            'Valeur de la cellule de la même ligne, colonne NoCol + 1
            Var2 = Cell.Offset(0, 1)
            'Valeur de la cellule de la même ligne, colonne NoCol + 2
            Var3 = Cell.Offset(0, 2)
            'Poursuivre si la variable est differente de "" "-" ou "0"
            MsgBox "Recherche sur?" & Var1
            If ((Var1 <> "") And (Var1 <> "-") And (Var1 <> "0") And (Var1 <> "Étiquettes de lignes")) Then
                '*** Récupération de l'adresse de la cellule lue ***
                'Adresse complète
                adres = Cell.Address
                'Numéro de ligne
                NoLig = Cell.Row
                'Numéro de colonne
                NoCol = Cell.Column

                'Pour tester : Affiche les variables dans la fenêtre Exécution de VBA
                Debug.Print adres & " " & NoLig & " " & NoCol & " "
                Debug.Print Var1 & " " & Var2 & " " & Var3
                'ActiveSheet.PivotTables("TableauNomsProfs").PivotSelect "AGULLO", _
                    xlDataAndLabel + xlFirstRow, True
                Sheets("planning intervention").Select
                ActiveSheet.Range("$A$1:$M$18901").AutoFilter Field:=7

                ActiveSheet.Range("$A$1:$M$18901").AutoFilter Field:=7, Criteria1:= _
                    "=" & Var1, Operator:=xlAnd
                'Application.CutCopyMode = False
                'Application.Wait Time + TimeSerial(0, 0, 5)
                MsgBox Var1 & " - ca donne quoi?"
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    "C:\Users\tmp\Documents\temp\CalendrierProf_" & Var1 & ".pdf" _
                    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                    :=False, OpenAfterPublish:=False
                MsgBox Var1 & " - document pdf crée?"
                Sheets("NomsProfs").Select
                If (Var1 = "A STOP") Then
                    Exit For
                End If
            Else
                MsgBox Var1 & " - passe "
            End If
        Next
    End With
    Set FL1 = Nothing
    Set Plage = Nothing
Le 20/10/2017 à 10:21

Chose encore plus surprenante, la création du .ics fonctionne correctement alors que je la fais avant la mise en pdf...

Sub exportpdf()
'
' exportpdf Macro
'
' Touche de raccourci du clavier: Ctrl+j
'

' TODO
' changements de cours à traiter
' nb lignes de la feuille generale automatique

Dim FL1 As Worksheet, Cell As Range, NoCol1 As Integer, NoCol2 As Long
Dim DerLig As Long, Plage As Range
'Les données récupérées
Dim Var1, Var2, Var3, adres As String, NoLig As Long, NoCol As Integer
Dim myICSFile As String, myICSRepertory As String, rng As Range, dateDebut As Variant, heureDebut As Variant, dureeCours As Variant, cellValue As Variant, i As Integer, j As Integer, LastRow As Integer, FirstRow As Integer

Dim dateFin As Variant, heureFin As Variant, promo As String, enseignantSoutien As String, matiere As String, salle As String
Dim heuresDebFin() As String
Dim idLigneIcs As String, nbSequence As Integer
Dim destinatairePDFs As Integer, envoyerEtudiants As Integer, envoyerProfs As Integer, envoyerAssistants As Integer, numColProf As Integer, numColAssist As Integer, colRefOuAssist As Integer
Dim nomProfReferant As String
Dim dateDebutAFaire As Date, dateFinAFaire As Date

envoyerProfs = 0
envoyerAssistants = 1
envoyerEtudiants = 2
numColProf = 7
numColAssist = 8
colRefOuAssist = numColProf

'destinatairesPDFs = envoyerAssistants
destinatairesPDFs = envoyerProfs

myICSRepertory = "C:\Users\temp"

'reinitialisation des filtres sur les 2 colones, idealement, il faudrait le faire sur tous les filtres
Sheets("planning intervention").Select
'supprime tous les filtres
ActiveSheet.Range("$A$1:$M$18902").AutoFilter Field:=numColAssist
ActiveSheet.Range("$A$1:$M$18902").AutoFilter Field:=numColProf

 Select Case destinatairesPDFs
   Case Is = envoyerProfs
        colRefOuAssist = numColProf
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Récap jour total!R1C8:R1048576C8", VERSION:=xlPivotTableVersion15). _
        CreatePivotTable TableDestination:="NomsProfs!R1C1", TableName:= _
        "TableauNomsProfs", DefaultVersion:=xlPivotTableVersion15
    'Sheets("Feuil3").Select
    Sheets("NomsProfs").Select
    'Cells(3, 1).Select
    With ActiveSheet.PivotTables("TableauNomsProfs").PivotFields( _
        "ENSEIGNANT REFERENT")
        .Orientation = xlRowField
        .Position = 1
    End With

    'ActiveSheet.PivotTables("TableauNomsProfs").AddDataField ActiveSheet. _
        PivotTables("TableauNomsProfs").PivotFields("ENSEIGNANT REFERENT"), _
        "Nombre de ENSEIGNANT REFERENT", xlCount

    'Instance de la feuille : Permet d'utiliser FL1 partout dans ...
    '... le code à la place de Worksheets("Feuil2")
    Set FL1 = Worksheets("NomsProfs")

   Case Is = envoyerAssistants
        colRefOuAssist = numColAssist
     ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
         "Récap jour total!R1C9:R1048576C9", VERSION:=xlPivotTableVersion15). _
         CreatePivotTable TableDestination:="NomsProfs!R1C1", TableName:= _
         "TableauNomsProfsSout", DefaultVersion:=xlPivotTableVersion15
     'Sheets("Feuil3").Select
     Sheets("NomsProfs").Select
     'Cells(3, 1).Select

     Sheets("NomsProfs").Select
     With ActiveSheet.PivotTables("TableauNomsProfsSout").PivotFields( _
         "ENSEIGNANT SOUTIEN")
         .Orientation = xlRowField
         .Position = 1
     End With
     'Sheets("NomsAssistants").Select
     'Set FL1 = Worksheets("NomsAssistants")

     Set FL1 = Worksheets("NomsProfs")
   End Select

    'Fixe le N° de première colonne de la plage à lire
    NoCol1 = 1

    'Fixe le N° de la dernière colonne de la plage à lire
    NoCol2 = 1

    'Détermine la dernière ligne renseignée de la feuille de calculs
    DerLig = Split(FL1.UsedRange.Address, "$")(4)

    'où FL1.Range(FL1.Cells(1, NoCol1), FL1.Cells(Derlig, NoCol2)) détermine
    'la plage de cellules à lire

    With FL1
        Set Plage = .Range(FL1.Cells(1, NoCol1), FL1.Cells(DerLig, NoCol2))
        'Utilisation de l'objet range (Cell) dans une boucle For Each... Next
        For Each Cell In Plage

            '*** Récupération des valeurs de plusieurs cellule ***
            'Valeur de la cellule lue
            Var1 = Replace(Application.WorksheetFunction.Clean(Cell.Value), "?", "_")
            'Var1 = Regex.Replace(Var1, "[^\w\.@-]", "")
            'Valeur de la cellule de la même ligne, colonne NoCol + 1
            Var2 = Cell.Offset(0, 1)
            'Valeur de la cellule de la même ligne, colonne NoCol + 2
            Var3 = Cell.Offset(0, 2)
            'Poursuivre si la variable est differente de "" "-" ou "0"
            'MsgBox "Recherche sur ? '" & Var1 & "'"
            'If (Trim(Var1) = vbNullString) Then MsgBox "J ai bien un espace pour '" & Var1 & "'"

            If ((Var1 <> "") And (Var1 <> "-") And (Var1 <> "0") And (Var1 <> "Étiquettes de lignes") And (Var1 <> "?") And (Var1 <> " ") And (Trim(Var1) <> vbNullString)) Then
                '*** Récupération de l'adresse de la cellule lue ***
                'Adresse complète
                adres = Cell.Address
                'Numéro de ligne
                NoLig = Cell.Row
                'Numéro de colonne
                NoCol = Cell.Column

                'Pour tester : Affiche les variables dans la fenêtre Exécution de VBA
                Debug.Print adres & " " & NoLig & " " & NoCol & " "
                Debug.Print Var1 & " " & Var2 & " " & Var3
                'selectionne la feuille sur laquelle on souhaite travailler
                Sheets("planning intervention").Select
                'supprime tous les filtres
                ActiveSheet.Range("$A$1:$M$18902").AutoFilter Field:=colRefOuAssist

                'filtre sur le nom
                ActiveSheet.Range("$A$1:$M$18902").AutoFilter Field:=colRefOuAssist, Criteria1:= _
                    "=" & Var1, Operator:=xlAnd

                    n = 0
                    Do Until Application.CalculationState = xlDone
                        DoEvents
                        n = n + 1
                    Loop
                    If n > 0 Then Debug.Print n

                'Application.CutCopyMode = False
                'Application.Wait Time + TimeSerial(0, 0, 5)
                'MsgBox Var1 & " - ca donne quoi?"

                '=====+++====== creation du .ics par prof =======+++========
                'va chercher le nombre de lignes

                Dim MaPlage As Range
                Set MaPlage = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
                LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                'FirstRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                'je compare les cellules de la colonne D
                Dim Ligne As Range, PrecVal As Variant

                  Debug.Print Var1 & " - lastRow = " & LastRow
                'creer le nom du fichier
                myICSFile = myICSRepertory & "\entreprise_" & Var1 & "_2017-2018.ics"
                'creer et ouvre le fichier pour pouvoir ecrire dedans
                Open myICSFile For Output As #1
                'pour debug, on utilise i
                i = 0
                Print #1, "BEGIN:VCALENDAR"
                Print #1, "VERSION:2.0"
                Print #1, "CALSCALE:GREGORIAN"
                Print #1, "X-WR-TIMEZONE:Europe/Paris"
                'parcourt toutes les lignes pour ecrire la date dans le fichier ics
                For Each Ligne In MaPlage.Rows
                'For i = 1 To 3 'LastRow
                  If (Ligne.Row > 1) Then
                    'idLigneIcs = Var1 & Ligne.Row & "@entreprise"
                    'nbSequence = 'doit trouver s'il existe et l'incrementer ou le creer à 0
                  'Faire le test pour l'existance de l'idLigneIcs -> permet de savoir si ca existe
                    ' si idIcs existe, ne rien faire sauf si le tag "a changer" est actif
                    'Faire le test ici sur le sequencage qui permet de savoir si c'est pour une modification ou pour une creation du document.

                   Debug.Print Var1 & " " & i & " - cell (" & Ligne.Row & ", 2) = " & Ligne.Cells(2)
                   Debug.Print Var1 & " " & i & " - date Debut = " & ActiveCell(Ligne.Row, 2).Value
                    dateDebut = Format(Ligne.Cells(2).Value, "yyyymmdd") ' formater la date en YYYYMMDD
                    'creer l'id qui sera utile pour l'insertion et la modification dans le calendrier ics
                    idLigneIcs = dateDebut & "_" & Var1 & "_" & Ligne.Row & "@entreprise"
                    Ligne.Cells(13).Value = idLigneIcs
                    Debug.Print Var1 & " " & i & " - date Debut = " & dateDebut
                   Debug.Print Var1 & " " & i & " - ActiveCell(i, 3).Value = " & Ligne.Cells(3).Value
                    'heuresDebFin() = Split(ActiveCell(Ligne.Row, 3).Value)
                    heuresDebFin() = Split(Ligne.Cells(3).Value)
                   Debug.Print Var1 & " " & i & " - " & Ligne.Row & " - date heure Debut = " & heuresDebFin(0) & ", heure fin = " & heuresDebFin(2)
                   'MsgBox "attends que je lise"
                    heureDebut = Replace(heuresDebFin(0), ":", "") & "00" ' recuperer la pemiere partie avant l'espace qui correspond a l'heure de debut
                    'dateFin = Format(ActiveCell(Ligne.Row, 2).Value, "yyyymmdd") ' formater la date en YYYYMMDD
                    dateFin = Format(Ligne.Cells(2).Value, "yyyymmdd") ' formater la date en YYYYMMDD
                    heureFin = Replace(heuresDebFin(2), ":", "") & "00" ' recuperer la 2e partie avant l'espace qui correspond a l'heure de fin
                   Debug.Print Var1 & " " & i & "-" & Ligne.Row & " - heureFin = " & heureFin
                    'dureeCours = ActiveCell(Ligne, 4).Value ' recuperer le temps du cours sans le h
                    dureeCours = Ligne.Cells(4).Value ' recuperer le temps du cours sans le h
                    'promo = ActiveCell(Ligne, 5).Value
                    promo = Ligne.Cells(5).Value
                   Debug.Print Var1 & " " & i & " - promo = " & promo
                    'matiere = ActiveCell(Ligne, 6).Value
                    matiere = Ligne.Cells(6).Value
                   Debug.Print Var1 & " " & i & " - matiere = " & matiere
                    'enseignantSoutien = ActiveCell(Ligne, 8).Value
                    enseignantSoutien = Ligne.Cells(numColAssist).Value
                    nomProfReferant = Ligne.Cells(numColProf).Value
                    If (enseignantSoutien = "0") Then
                        enseignantSoutien = ""
                    Else
                        enseignantSoutien = " - " & enseignantSoutien
                    End If

                   Debug.Print Var1 & " " & i & " - enseignantSoutien = " & enseignantSoutien
                    'salle = ActiveCell(i, 11).Value
                    salle = Ligne.Cells(11).Value

                    'ecrit avec le bon format dans le fichier ics
                    Print #1, "BEGIN:VEVENT"
                    Print #1, "DTSTART:" & dateDebut & "T" & heureDebut
                    Print #1, "DTEND:" & dateFin & "T" & heureFin  ' mettre plutot la duree si possible
                    'Print #1, "DTSTAMP:20171003T122252Z"
                    Print #1, "UID:" & idLigneIcs 'creer un uid pour cette ligne et la mettre ici. Penser a la sauvegarder lors de changements
                    'Print #1, "CREATED:19000101T120000Z"
                    Print #1, "DESCRIPTION:entreprise  - " & matiere & " avec les " & promo & " en salle  " & salle & " - " & nomProfReferant & enseignantSoutien
                    'Print #1, "LAST-MODIFIED:20171003T121039Z"
                    Print #1, "LOCATION:" & salle
                    'Print #1, "SEQUENCE:" & nbSequence ' est supposé etre incrementé quand on modifie
                    Print #1, "STATUS:CONFIRMED"
                    Print #1, "SUMMARY:entreprise - " & matiere & " avec " & promo
                    'Print #1, "TRANSP: OPAQUE"
                    'Print #1, "BEGIN: VALARM"
                    'Print #1, "ACTION: DISPLAY"
                    'Print #1, "DESCRIPTION:This is an event reminder"
                    'Print #1, "TRIGGER:-P0DT0H10M0S"
                    'Print #1, "END: VALARM"
                    Print #1, "END:VEVENT"
                    i = i + 1
                    'If (i > 3) Then
                    '    Exit For
                    'End If
                  End If
                Next
                Print #1, "END:VCALENDAR"
                'ferme le fichier de ce prof
                Close #1

                'creation du pdf
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    "C:\Users\temp\2017-2018_" & Var1 & ".pdf" _
                    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                    :=False, OpenAfterPublish:=False
                'MsgBox Var1 & " - document pdf crée?"
                Sheets("NomsProfs").Select

            Else
                'MsgBox Var1 & " - passe "
                Debug.Print Var1 & " - passe "
            End If
        Next
    End With
    Set FL1 = Nothing
    Set Plage = Nothing

End Sub
Rechercher des sujets similaires à "parcourir filtre auto vba"