splitStr не создает правильную дату.

Question

Я создал макрос в контрольном списке, чтобы добавить простой элемент управления в команду, но теперь он начал поместить дату в формате США вместо формата в Великобритании. Я не понимаю, почему, и я не могу это исправить. Кто-нибудь может помочь? Это все работает кроме формате даты

splitstr = Split(Format(Now, "dd/mm/yyyy"), "/") 
d = DateSerial(CInt(splitstr(2)), CInt(splitstr(1)), CInt(splitstr(0))) 
'Display it in the proper format 

With Target.Offset(0, 4) 
.Value = d 
.NumberFormat = "dd/mm/yyyy" 
    End With 

Полный макро ниже:

Option Explicit 
Dim wb As Workbook, wk As Worksheet, str As String, d As String, splitstr As Variant 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 

'Limit Target count to 1 
If Target.Count > 1 Then Exit Sub 
'Isolate Target to a specific range 
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub 
ActiveSheet.Unprotect "checklist" 
'Set Target font to "marlett" 
Target.Font.Name = "marlett" 
'Check value of target 
If Intersect(Target, Range("SignOff")) Is Nothing Then 
    Else 
    If WorksheetFunction.CountA(Range("Ckboxes")) < 34 Then 
    Range("I7").Select 
    MsgBox "There are items that aren't checked off. Please mark everything as complete first." 
    Exit Sub 
    Else 
    Dim iReply As Integer 

iReply = MsgBox(Prompt:="Are You Certain You Want To Sign Off This Checklist?", _ 
     Buttons:=vbYesNo, Title:="Sign Off?") 
If iReply = vbNo Then 
Range("Date").Select 
Exit Sub 
End If 
    Target.Value = "a" 'Sets target Value = "a" 
    Target.Offset(0, 2).Value = Environ("UserName") 
    Target.Offset(0, 1).Value = Format(Now, "hh:mm:ss") 

splitstr = Split(Format(Now, "dd/mm/yyyy"), "/") 
d = DateSerial(CInt(splitstr(2)), CInt(splitstr(1)), CInt(splitstr(0))) 
'Display it in the proper format 

With Target.Offset(0, 4) 
.Value = d 
.NumberFormat = "dd/mm/yyyy" 
    End With 


    Set wb = ThisWorkbook 
Set wk = ThisWorkbook.Sheets("Checklist") 
wb.Save 

If wk.Range("SignOff") = "a" Then 

str = "H:\Finance\Controls\Checklist\Daily Checklist\" 
'Checks the location exists, and if not then makes it 
If Dir(str, vbDirectory) = "" Then MkDir str 
'Same as above 
str = str & Format(Range("K6"), "yyyy") & "\" 
'Same as above 
If Dir(str, vbDirectory) = "" Then MkDir str 
'Same as above 
str = str & Format(Range("K6"), "mm - mmmm yy") & "\" 
'Same as above 
If Dir(str, vbDirectory) = "" Then MkDir str 

wb.SaveAs (str & "Finance Daily Checklist " & Format(Range("K6"), "dd mmm") & ".xlsm") 

Set wb = Workbooks.Open(Filename:="H:\Finance\Controls\Checklist\Daily Checklist\Finance Daily Checklist Master.xlsm") 
Set wk = wb.Sheets(1) 
ActiveSheet.Unprotect "checklist" 
wk.Range("I7").Value = "Master File" 
wk.Range("K6").ClearContents 
wk.Range("Ckboxes").ClearContents 
wk.Range("Ckboxes2").ClearContents 
wk.Range("Notes").ClearContents 

wk.Range("9:59").EntireRow.Hidden = False 

ActiveSheet.Protect "checklist" 
wk.Range("I7").Select 
wb.Save 
wb.Close 
Exit Sub 
End If 
End If 
End If 

If Target.Value <> "a" Then 
    Target.Value = "a" 'Sets target Value = "a" 
    Target.Offset(0, 2).Value = Environ("UserName") 
    Target.Offset(0, 1).Value = Format(Now, "hh:mm:ss") 
    Target.Offset(0, 4).Value = Format(Now, "dd-mm-yyyy") 

    Cancel = True 
    ActiveSheet.Protect "checklist" 
    Exit Sub 
End If 
If Target.Value = "a" Then 
    Cancel = True 
    ActiveSheet.Protect "checklist" 
    Exit Sub 
End If 

End Sub 

Answer 1

Попробуйте это:

With Target.Offset(0, 4) 
    .Value = Format(Now, "dd\/mm\/yyyy") 
    .NumberFormat = "dd\/mm\/yyyy" 
End With 

.

Вы можете удалить эти 2 строки:

splitstr = Split(Format(Now, "dd/mm/yyyy"), "/")

d = DateSerial(CInt(splitstr(2)), CInt(splitstr(1)), CInt(splitstr(0)))