Export pointage VBA

Bonjour,

J'ai créé petit à petit un fichier Excel me permettant de faire mes pointages et grâce à un bouton, cela doit me les compiler dans un fichier au format .CSV et l'enregistrer dans un dossier parallèle

Or, lorsque je lance le script, cela me génère un fichier .CSV vierge...

Quelqu'un pourrait-il m'éclairer ?

Ci-joint le fichier Excel et le code VBA

'Retourne le numero de semaine d'une date
Function RetournerNumeroDeSemaine(uneDate As Date) As Integer

    RetournerNumeroDeSemaine = DatePart("ww", uneDate)

End Function

Sub ValiderPointages()

    Dim nSemSource As Integer
    Dim nSemCible As Integer
    Dim ongletSource As String
    Dim ongletCible As String

    ''' 1- Définir les numéros de semaine concernés par l'onglet actif et cible
    nSemSource = RetournerNumeroDeSemaine(Cells(3, 6))
    nSemCible = nSemSource + 1

    ''' 2- Dupliquer le tableau de la semaineSource de l'ongletSource vers la semaineCible dans un ongletCible
    ongletSource = "S" & CStr(nSemSource)
    ongletCible = "S" & CStr(nSemCible)
    DupliquerEtViderTableau ongletSource, ongletCible 'tout sauf le nom
    DupliquerBouton ongletSource, ongletCible, "Valid"

    ''' 3- Exporter le pointage au format ONAYA
    ExportCSVPointages ongletSource

    ''' 4- Colorer onglet
    ColorierOnglet

End Sub

Sub Appeler_ExportPointage()

    Set WB1 = ThisWorkbook
    Set ws1 = WB1.Sheets("Parametrage")

    ExportPointages ws1.Cells(2, 3), ws1.Cells(3, 3)

End Sub

Sub DupliquerBouton(ongSource As String, ongCible As String, nomBouton As String)

    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim originalButton As Button
    Dim newButton As Button

    ' Définir les feuilles source et destination
    Set sourceSheet = ThisWorkbook.Sheets(ongSource)
    Set destSheet = ThisWorkbook.Sheets(ongCible)

    ' Identifier le bouton original
    Set originalButton = sourceSheet.Buttons(nomBouton)

    ' Copier le bouton original
    originalButton.Copy

    ' Coller le bouton sur la feuille de destination
    destSheet.Paste Destination:=destSheet.Range("M3")

    ' Identifier le nouveau bouton
    Set newButton = destSheet.Buttons(destSheet.Buttons.Count)

    ' Copier les propriétés du bouton original vers le nouveau bouton
    With newButton
        .Caption = originalButton.Caption
        .Top = originalButton.Top
        .Left = originalButton.Left
        .Width = originalButton.Width
        .Height = originalButton.Height

    End With

    ' Copier l'événement clic du bouton original vers le nouveau bouton
    ' Note : Cela nécessite que l'événement clic soit dans un module standard
    newButton.OnAction = originalButton.OnAction

End Sub

' Dupliquer le format du tableau Source en changeant les dates
Sub DupliquerEtViderTableau(ongSource As String, ongCible As String)

    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim headers As Range
    Dim cell As Range
    Dim sheetExists As Boolean
    Dim ws As Worksheet
    Dim csvFilePath As String
    Dim csvFile As Integer
    Dim i As Long, j As Long

    ' Définir l'onglet source
    Set sourceSheet = ThisWorkbook.Sheets(ongSource)

    ' Vérifier si l'onglet cible (semaine suivante) existe
    sheetExists = False
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = ongCible Then
            sheetExists = True
            Set targetSheet = ws
            Exit For
        End If
    Next ws

    ' Si la feuille n'existe pas, la créer
    If Not sheetExists Then
        Set targetSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        targetSheet.Name = ongCible
    End If

    ' Copier le format de la plage source vers la plage cible
    Set sourceRange = sourceSheet.Range("B3:J25")
    sourceRange.Copy
    targetSheet.Range("B3").PasteSpecial Paste:=xlPasteFormats

    ' Copier les en-têtes de la plage source vers la plage cible
    Set headers = sourceSheet.Range("B3:E3")
    headers.Copy
    targetSheet.Range("B3").PasteSpecial Paste:=xlPasteValues
        ' En changeant les dates de la semaine
        targetSheet.Cells(3, 6) = sourceSheet.Cells(3, 6) + 7
        targetSheet.Cells(3, 7) = sourceSheet.Cells(3, 7) + 7
        targetSheet.Cells(3, 8) = sourceSheet.Cells(3, 8) + 7
        targetSheet.Cells(3, 9) = sourceSheet.Cells(3, 9) + 7
        targetSheet.Cells(3, 10) = sourceSheet.Cells(3, 10) + 7
        targetSheet.Cells(24, 5) = sourceSheet.Cells(24, 5)
        targetSheet.Cells(24, 6).Formula = sourceSheet.Cells(24, 6).Formula
        targetSheet.Cells(24, 7).Formula = sourceSheet.Cells(24, 7).Formula
        targetSheet.Cells(24, 8).Formula = sourceSheet.Cells(24, 8).Formula
        targetSheet.Cells(24, 9).Formula = sourceSheet.Cells(24, 9).Formula
        targetSheet.Cells(24, 10).Formula = sourceSheet.Cells(24, 10).Formula
        targetSheet.Cells(25, 8).Formula = sourceSheet.Cells(25, 8).Formula

    ' Nettoyer le presse-papiers
    Application.CutCopyMode = False

End Sub

Sub ExportCSVPointages(ongSource As String)

    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Sheets(ongSource)

    Dim nomSalarie As String
    nomSalarie = "VIALELLES"

    Dim cheminCSV As String
    cheminCSV = "C:\Users\jeff.vialelles\Desktop\Nouveau dossier"

    ' Définir la plage source
    Set sourceRange = sourceSheet.Range("B3:J25")

    ' Définir le chemin et le nom du fichier CSV
    csvFilePath = cheminCSV & "\Export_CSV-" & nomSalarie & "-" & ongSource & "-2024.csv"

    ' Ouvrir un fichier pour écrire le CSV
    csvFile = FreeFile
    Open csvFilePath For Output As #csvFile

    ' On écrit les lignes dans le CSV
    Dim NumLigne As Integer

    NumLigne = 2
    Cells(1, 26) = "N° de pointage,CODE ONAYA (from Personnel),Date,Temps pointé (Graphique),Affaire"
    For i = 4 To 23
        For j = 6 To 10
            If Cells(i, j).Value <> "" Then
                Cells(i, j) = Replace(Cells(i, j), ",", ".")
                Cells(NumLigne, 26) = NumLigne - 1 & "," & nomSalarie & "," & Cells(3, j) & "," & Cells(i, j) & "," & Cells(i, 3)
                Print #csvFile, Cells(NumLigne, 26) & "," & vbCrLf;
                NumLigne = NumLigne + 1
            End If
        Next j
    Next i

    ' Fermer le fichier CSV
    Close #csvFile

End Sub

' Colorer l'onglet importé en vert
Sub ColorierOnglet()

    nSemSource = RetournerNumeroDeSemaine(Cells(3, 6))
    ongletSource = "S" & CStr(nSemSource - 1)

    ' Sélectionner l'onglet à colorier en vert
    Sheets(ongletSource).Tab.Color = RGB(0, 176, 80)

End Sub

Bonjour,

d’après la doc FreeFile function (Visual Basic for Applications) | Microsoft Learn il semble que c’est l’instruction “Write” plutot que print que vous devriez utiliser…

Mais une question, pourquoi ne pas simplement utiliser Worksheet.SaveAs method (Excel) | Microsoft Learn avec le format CSV ? Ca m’a l’air quand meme beaucoup plus simple et rapide.

Je pense qu’il est également possible d’automatiser votre process avec powerquery, en définissant un export CSV à la fin. Cela vous permettrait d’effectuer le traitement éventuel des données + export en un rien de temps.

Bonjour et merci pour votre réponse.

Je ne connais pas Worksheet.SaveAs method (Excel) | Microsoft Learn et je pense être pas très loin du but en ayant utilisé un ancien fichier.

Je ne connais pas Powerquery non plus

Rechercher des sujets similaires à "export pointage vba"