Microsoft 365 VBA format date donnée msgbox

Lucie44

XLDnaute Nouveau
bonjour,

dans une macro je demande la date à renseigner sur toutes les lignes du tableau.
Je renseigne 01/07/2022 dans la msgbox, mais dans la cellule j'obtiens 017/01/2022
j'ai essayer de changer le format :
Range("C2") = Format(DateJ, "dd/mm/yyyy") me donne 07/01/2022
Range("C2") = Format(DateJ, "jj/mm/yyyy") me donne jj/07/2022
Range("C2") = Format(DateJ, "jj/mm/aaaa") me donne jj/07/aaaa
Range("C2") = Format(DateJ, "jj.mm.aaaa") me donne 01.07.2022

Mais dans le format 01.07.2022 je ne peux pas faire d'import dans mon logiciel j'aurai besoin du format 01/07/2022 est ce possible?

Merci d'avance
 

vgendron

XLDnaute Barbatruc
bonjour

pour saisir la date, tu dis passer par un msgbox.. ne s'agit il pas plutot d'un Inputbox?

perso.. je viens de faire ce test
VB:
Sub test2()

jour = Application.InputBox("donnez une date")
MsgBox CDate(jour)
End Sub


si je saisis
31/07/2022==> il m'affiche 31/07/2022
07/31/2022==>31/07/2022
2022/07/31==>31/07/2022
2022/07/31==>31/07/2022

le seul cas qu'il n'aime pas, c'est 2022/31/07
 

Phil69970

XLDnaute Barbatruc
Bonjour @Lucie44
Edit : Bonjour @vgendron Grillé sur la photofinish 🤣

Je te propose un petit test dans une nouvelle feuille tu mets cette macro
J'ai mis date - 6 car nous sommes le 7 juillet - 6 = 1 juillet
VB:
Sub TestDate()
[C2].NumberFormat = "dd/mm/yyyy"
[C2].Value = Date - 6                           '==> 01/07/2022 la date est ok
Range("C3") = Format(Date - 6, "dd/mm/yyyy")    '==> 07/01/2022 la date est ko
End Sub

Merci de ton retour

@Phil69970
 

Lucie44

XLDnaute Nouveau
bonjour ca a un peu évoluer mais pas complètement OK.
avec la notion cdate j'ai bien la date au bon format qui s'affiche dans mes feuilles excel.
je recopie valeur et format dans une autre feuille jusque là c'est bon, et cette nouvelle feuille je veux la sauvegarder dans un nouveau classeur au format txt avec tabulation. et lorsque j'ouvre mon bloc note avec le contenu au format txt, la date est de nouveau 7/1/2022 (sans les 0 pour 07/01)
comment puis je y remédier?

je ne peux pas faire le -6, car aujourd'hui c'est 01/07 - 07/01 mais au 31/07 je ne voudrais pas retiré 6. c'est un fichier qui sert à chaque début et chaque fin de mois.

il me faut juste réussi à mettre/sauvegarder la date au bon format.



'Inserer une colonne pour avoir l'info date, que l'on demande à l'utilisateur via une boite de dialogue
Sub InsereColonne()
Columns(3).Insert Shift:=xlToRight
Range("C1").Value = "Date"
Dim DateJ As String, Dernligne As Long
DateJ = InputBox("Merci de renseigner la date à laquelle la facture doit être établie.")
Range("C2") = CDate(DateJ)
Range("C3") = CDate(DateJ)
Dernligne = Range("B" & Rows.Count).End(xlUp).Row
Range("C2:C3").AutoFill Destination:=Range("C2:C" & Dernligne)

End Sub


'Recopier les colonnes A à I sur la feuille sage pour export vers fichier txt
Sub CopierEcritures()
Dim Dernligne As Long
Worksheets("etape2").Select
Dernligne = Range("B" & Rows.Count).End(xlUp).Row

Columns("A:L").Select
ActiveWorkbook.Worksheets("Etape2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Etape2").Sort.SortFields.Add2 Key:=Range("A2:A" & Dernligne) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Etape2").Sort
.SetRange Range("A1:I" & Dernligne)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("A1:I" & Dernligne).Copy
Sheets("sage").Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub


'Creation fichier et sauvegarde d'un fichier d'export en format txt ca bug ici

Sub ExportTXT()
Dim NomDuFichier As String
Dim Chemin As String
Dim Libelle As String

Chemin = "X:\Nantes\Rieux\Compta Cabinet\RESULTAT\2022\COPRO\Transfert Sage Factures\"
Libelle = InputBox("Merci de renseigner le libellé du fichier d'export vers SAGE")
NomDuFichier = Libelle
ActiveSheet.Copy
ActiveWorkbook.SaveAs Chemin & NomDuFichier & ".txt", _
FileFormat:=xlText, CreateBackup:=False
MsgBox ("La Création & la Sauvegarde de: " + NomDuFichier + " est OK dans le répertoire suivant:" & Chr(13) & Chr(10) & "X:\Nantes\Rieux\Compta Cabinet\RESULTAT\2022\COPRO\Transfert Sage Factures")
ActiveWorkbook.Close
End Sub
 

Lucie44

XLDnaute Nouveau
problème résolut
ainsi

'Recopier les colonnes A à I sur la feuille sage pour export vers fichier txt
Sub CopierEcritures()
Dim Dernligne As Long
Worksheets("etape2").Select
Dernligne = Range("B" & Rows.Count).End(xlUp).Row

Columns("A:L").Select
ActiveWorkbook.Worksheets("Etape2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Etape2").Sort.SortFields.Add2 Key:=Range("A2:A" & Dernligne) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Etape2").Sort
.SetRange Range("A1:I" & Dernligne)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


Range("A1:I" & Dernligne).Copy
Sheets("sage").Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns(3).Select
Columns(3).NumberFormat = "dd/MM/yyyy"
End Sub



'Creation fichier et sauvegarde d'un fichier d'export en format txt

Sub ExportTXT()
Dim NomDuFichier As String
Dim Chemin As String
Dim Libelle As String

Chemin = "X:\Nantes\Rieux\Compta Cabinet\RESULTAT\2022\COPRO\Transfert Sage Factures\"
Libelle = InputBox("Merci de renseigner le libellé du fichier d'export vers SAGE")
NomDuFichier = Libelle
ActiveSheet.Copy
ActiveWorkbook.SaveAs Chemin & NomDuFichier & ".txt", _
FileFormat:=xlText, CreateBackup:=True
Application.DisplayAlerts = False
MsgBox ("La Création & la Sauvegarde de: " + NomDuFichier + " est OK dans le répertoire suivant:" & Chr(13) & Chr(10) & "X:\Nantes\Rieux\Compta Cabinet\RESULTAT\2022\COPRO\Transfert Sage Factures")
ActiveWorkbook.Close
End Sub
 

Discussions similaires

Réponses
8
Affichages
373

Membres actuellement en ligne

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 105
dernier inscrit
Joffrette