VBA - Format date 24h-AM/PM

Bonjour et merci d'avance pour votre aide,

Je travail dans un pays anglophone avec un Excel au format horaire AM/PM (et qui doit rester configurer tel quel).

Dans mon projet je récupère des données de plusieurs fichiers afin de les importer dans une BdD (1 fichier = 1 onglet dans la BdD).

Dans mon fichier source la date est de la forme "dd/MM/yyyy HH:mm:ss" au format 24h. Comme je souhaite récupérer uniquement l'heure (sans minutes et secondes) j'ai inscris ces lignes dans mon code:

        Range(Selection, Selection.End(xlDown)).Select
        Selection.NumberFormat = "HH;@"

J'ai essayé plusieurs format mais impossible d'obtenir la date en format 24H, le rendu est toujours en AM/PM.

Avec vous une solution? Merci

En Plus:

Voici mon code en entier en version anonyme, si certaines personnes voient des pistes d'optimisation je suis preneur! (à part la mise en forme date il fonctionne)

Sub Regroupement()

'Openning of DATABASE

Dim DatabaseFile As Workbook

Set DatabaseFile = Workbooks.Open("DATABASE.xlsx")

'Global variables

 Dim File As String
 Dim NewestFile As String
 Dim MainPath As String
 Dim Path As String
 Dim dt As String
 Dim FileTABLE(35) As String
        FileTABLE(1) = "a"
        FileTABLE(2) = "b"
        FileTABLE(3) = "c"
        FileTABLE(4) = "d"
        FileTABLE(5) = "e"
        FileTABLE(6) = "f"
        FileTABLE(7) = "g"
        FileTABLE(8) = "h"
        FileTABLE(9) = "i"
        FileTABLE(10) = "j"
        FileTABLE(11) = "k"
        FileTABLE(12) = "l"
        FileTABLE(13) = "m"
        FileTABLE(14) = "n"
        FileTABLE(15) = "o"
        FileTABLE(16) = "p"
        FileTABLE(17) = "q"
        FileTABLE(18) = "r"
        FileTABLE(19) = "s"
        FileTABLE(20) = "t"
        FileTABLE(21) = "u"
        FileTABLE(22) = "v"
        FileTABLE(23) = "w"
        'FileTABLE(24) = "x"
        FileTABLE(24) = "y"
        FileTABLE(25) = "z"
        FileTABLE(26) = "aa"
        FileTABLE(27) = "ab"
        FileTABLE(28) = "ac"
        FileTABLE(29) = "ad"
        'FileTABLE(30) = "ae"
        FileTABLE(30) = "af"
        FileTABLE(31) = "ag"
        FileTABLE(32) = "ah"
        FileTABLE(33) = "ai"
        FileTABLE(34) = "aj"
        FileTABLE(35) = "ak"

 MainPath = "x\Reports"

'Openning and treatment of the newest Report for each report database

 i = 1

 Do

 Path = MainPath & "\" & FileTABLE(i)
 File = Dir(MainPath & "\" & FileTABLE(i) & "\" & FileTABLE(i) & "_*.xls")
 Do Until File = ""
 If Right$(File, 8) > dt Then
 dt = Right$(dt, 8)
 NewestFile = File
 End If
 File = Dir
 Loop
 Workbooks.Open (Path & "\" & NewestFile) ', CorruptLoad:=xlExtractData

'Separation of the Date and Time

 Application.DisplayAlerts = False

    If Not Range("C13").Find("*") Is Nothing Then
        Columns("C:C").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Columns("C:C").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("B13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.TextToColumns Destination:=Range("B13"), DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
          Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
          :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        Range("B13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.NumberFormat = "dd-mmm-yy"
        Range("C13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.NumberFormat = "h:mm:ss;@"
        Columns("D:D").Delete Shift:=xlToLeft

'Collection of the data

  Range("B13").Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  Selection.Copy

'Pasting of the data

  Workbooks("DATABASE").Activate
  Sheets(i).Activate
  ActiveSheet.Range("A65000").End(xlUp)(2).Select
  ActiveSheet.Paste

  End If

'Closing the raw report

 Workbooks(NewestFile).Activate
 ActiveWorkbook.Close savechanges:=False

 Application.DisplayAlerts = True

 i = i + 1

 Loop Until i = 35

End Sub

Merci beaucoup à vous tous

Bonjour,

Essaye comme ça :

Selection.NumberFormat = "[$-409]h:mm AM/PM;@"

Bonjour et merci pour votre réponse,

Ce format permet de passer en AM/PM alors que c'est justement ce que je veux éviter.

Je joins un fichier avec mon problème. Il est possible que le problème n'apparaisse pas chez vous car je suspècte la version de mon excel (internationnal).

Ce que je veux réaliser:

Séparer la colonne A en deux colonnes. Une avec la date format "jj/mm/aaaa" et une avec uniquement le chiffre de l'heure format "hh"

Ce que la macro réalise sur mon poste:

Sépare la colonne A en trois colonne. Une avec la date format "jj/mm/aaaa", une uniquement le chiffre de l'heure format "hh" sur 12heures et une colonne AM/PM.

J'éspère que c'est plus clair comme ça.

Merci encore,

Alexandre

Re,

Il faut essayer comme ça :

    Selection.NumberFormat = "hh:mm;@"

Re,

Cela ne marche pas non plus...

Merci

Alexandre

Re,

A force de chercher sur le problème j'ai écris une solution complètement moche mais qui fonctionne.

Quand l'énervement prend le dessus :

Columns("C:C").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Columns("C:C").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Columns("C:C").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Columns("C:C").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("B13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.TextToColumns Destination:=Range("B13"), DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
          Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
          :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        Range("B13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.NumberFormat = "dd-mmm-yy"
        Range("C13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.NumberFormat = "[$-409]h;@"
        Range("F9").Select
        ActiveCell.FormulaR1C1 = "12:00:00"
        Range("F9").Select
        Selection.NumberFormat = "hh"
        Range("E13").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""AM"",RC[-2],RC[-2]+R9C6)"
        Range("E14").Select
        Columns("E:E").EntireColumn.AutoFit
        Range("E13").Select
        Selection.AutoFill Destination:=Range("E13:E50"), Type:=xlFillDefault
        Range("E13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.NumberFormat = "hh"
        Range("E13").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Range("F13").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Selection.NumberFormat = "hh"
        Columns("E:E").Delete Shift:=xlToLeft
        Columns("D:D").Delete Shift:=xlToLeft
        Columns("C:C").Delete Shift:=xlToLeft

En revanche si vous avez une meilleure solution je suis bien évidemment preneur

Merci,

Alexandre