Bonjour à tous,
 
Je bloque sur du code en VBA.
 
Je m'explique, je dois extraire les diplomes acquis par les salariés mais bien évidemment certains en ont un et d'autres plusieurs.
 
Je voudrai donc créer une condition du genre si plusieurs diplomes alors affiche-les(donc créations de nouvelles lignes) sinon s'il y en a qu'un affiche le(pas de création de nouvelles lignes).
 
Et je voudrai aussi savoir si quelqu'un saurait si il existe une référence sous VBA pour que lors de l'importations de fichiers, les dates au format jj/mm/aaaa soit prises en compte à ce format et pas en calcul Excel.
 
pour que ce soit plus claire, voivi mon code :
 
 
 
Option Explicit
Dim NbFichiers As Integer
Dim DossierOk As String
'   Dossier des classeurs à traiter
Const Dossier As String = "W:\HrAccess\Cellule_SIRH_Support\B - MINI-PROJETS\2 - Autres projets\CV SITA Evolution\Diplomes\REPONSES\STOCK"
 
Private Sub Entete()
    '   Tout effacer
    ShImport.Cells.Clear
    ShImport.Range("A3" ).Formula = "Fichier"
 
    ' identification, diplôme, langues, expériences professionnelles.
    ShImport.Range("B3" ).Formula = "Date"
    ShImport.Range("C3" ).Formula = "Ecole / Organisme"
    ShImport.Range("D3" ).Formula = "Diplôme"
End Sub
 
Private Sub ListeFichiersDans(ByVal sNomDossier As String)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder
Dim fichier As Scripting.file
Dim r As Long
 
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(sNomDossier)
    '   Mettre le compteur à 0
    NbFichiers = 0
    '   Récupérer en haut la 1ere ligne vierge
    r = ShImport.Range("A65536" ).End(xlUp).Row + 1
     
    ' Balayer le dossier et extraire le nom des fichiers
    For Each fichier In DossierSource.Files
        ShImport.Cells(r, 1) = fichier.Name
        NbFichiers = NbFichiers + 1
        r = r + 1
    Next fichier
     
    Set fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub
 
'   Permet de lire une valeur dans un fichier Excel fermé
Private Function ExtraireValeur(Dossier, fichier, feuille, Cellule)
Dim argument As String
    argument = "'" & Dossier & "[" & fichier & "]" & feuille & "'!" & Range(Cellule).Address(, , xlR1C1)
    ExtraireValeur = ExecuteExcel4Macro(argument)
End Function
 
Sub btnImport_QuandClic()
Dim Debut As Variant
Dim NumeroLigne As Integer, i As Integer
Dim NomFichier As String
'   On suppose que tous les fichiers contiennent
'   les données dans Feuil1
Const NomFeuille As String = "CV"
 
    ' Par curiosité
    Debut = Time()
    Application.ScreenUpdating = False
        Entete
        DossierOk = Dossier
        If Right(DossierOk, 1) <> "\" Then DossierOk = DossierOk & "\"
        ListeFichiersDans DossierOk
         
        ' Si un onglet de NomFichier ne s'appelle pas NomFeuille
        ' une erreur #REF! est incrite dans les cellules concernées
         
        ' On démarre à cette ligne
        NumeroLigne = 4
        For i = 1 To NbFichiers
            NomFichier = ShImport.Range("A" & NumeroLigne)
 
            Cells(NumeroLigne, 2) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "C17" )
            Cells(NumeroLigne, 3) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "D17" )
            Cells(NumeroLigne, 4) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "G17" )
   
            NumeroLigne = NumeroLigne + 1
            Application.StatusBar = i & " / " & NbFichiers
        Next
         
        Application.StatusBar = "Terminé : " & Format((Time() - Debut) * 100000, "0.00" )
     
        ' Revenir en haut à gauche
        With ActiveWindow
            .ScrollRow = 1
            .ScrollColumn = 1
        End With
         
        Rows("3:3" ).Font.Bold = True
        Columns("B:D" ).Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
        Columns("A:I" ).Columns.AutoFit
        Range("A1" ).Select
     
    '   Rafraichier l'écran à la fin du traitement
    Application.ScreenUpdating = True
End Sub
 
Private Sub DispoBoutons()
Dim t As Range
    ' Positionner et cadrer le bouton
    With ShImport
        .Activate
        .Rows(1).RowHeight = 12.75
        .Rows(2).RowHeight = 12.75
         
        Set t = .Cells(1, 3)
        With .Buttons("btnImport" )
            .Left = t.Left + 3
            .Top = t.Top + 5
            .Width = t.Width - 6
            .Height = Rows(1).RowHeight + Rows(2).RowHeight - 8
        End With
    End With
End Sub
 
Private Sub Workbook_Open()
    ' S'exécutera automatiquement à l'ouverture du fichier
    DispoBoutons
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    Range("A1" ).Select
End Sub
 
 
 
Merci pour votre aide.
 

Bonjour,
Je n'ai pas tout lu, mais ta colonne réceptrice pour les dates a-t-elle un format date?
Cordialement

Bonjour,
 
Non, mes colonnes réceptrice pour les dates n'ont pas un format date
 
Comment faire??
 
Merci

Pour changer le format d'une cellule, il faut utiliser la fonction NumberFormat (ou NumberFormatLocal)
 
Exemple  

 
A essayer
 
++