Excel VBA：從任何操作系統區域/區域解析英文日期

Question

我有一個帶有日期選擇器的電子表格。日，月，年的單獨細胞被選中，像這樣：

然後，我有一些代碼，拿起選定的日期，然後檢查它是否是一個真正的日期（例如，不2月31日），然後檢查它是否「大於或等於」單元格A1中的預設日期。 A1中預設日期的格式並不重要，只要它是日期格式即可。

該功能工作得很好，直到我將我的OS區域更改爲例如西班牙。因爲非常簡單，CDate（blah）可以在英國/美國地區解析「2016年1月1日」，但在西班牙地區模式下，期望看到Enero，febrero，marzo，abril等，而不是1月，2月等。這是（Windows）中我使用的是效仿其他地區設置：步驟是

Sub getDate() 
    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    theCurrentDate = theDay & " " & theMonth & " " & theYear 

    'highlight bad date: 
    If Not IsDate(theCurrentDate) Then 
     Cells(13, 9).Interior.ColorIndex = 38 
     Exit Sub 
    End If 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub 

「標明劣棗」：

這是我的代碼片段代碼在非英語區域/區域設置中會出現問題......它將突出顯示日期單元格。我認爲這是一種很好的方法，可以發現2月30日這樣的不良日期，同時要記住所有三個單元格都是使用列表進行數據驗證的。

選擇日期而不是鍵入日期很重要，我想保持DD-Month-YYYY的可視格式，以超越文化（閱讀：強制用戶符合單一格式）。

我一直在努力解決如何告訴它假裝程序語言環境是英國的代碼...或告訴它，它的日期是在英國的語言環境...我可以'噸數字，任何建議表示讚賞。謝謝。

---

EDIT1：我找到了解決此問題的解決方法。這可以通過將月份名稱轉換爲數字，然後使用DateSerial函數將其轉換爲...序列日期來實現。問題是，如果你給它一個4月31日的日期（4月有30天），那麼日期序列轉換將在5月1日結束。所以我不得不做一個例程，手動檢查它是一個合法的日期（包括閏年）...這裏是新代碼，再次簡化，儘管我已經包括了錯誤處理，但這次只是爲了使它更完整）：

Sub getDate() 
    theErr = 0 
    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    'Convert month name to number: 
    If theMonth = "January" Then 
     theMonth = 1 
    ElseIf theMonth = "February" Then 
     theMonth = 2 
    ElseIf theMonth = "March" Then 
     theMonth = 3 
    ElseIf theMonth = "April" Then 
     theMonth = 4 
    ElseIf theMonth = "May" Then 
     theMonth = 5 
    ElseIf theMonth = "June" Then 
     theMonth = 6 
    ElseIf theMonth = "July" Then 
     theMonth = 7 
    ElseIf theMonth = "August" Then 
     theMonth = 8 
    ElseIf theMonth = "September" Then 
     theMonth = 9 
    ElseIf theMonth = "October" Then 
     theMonth = 10 
    ElseIf theMonth = "November" Then 
     theMonth = 11 
    ElseIf theMonth = "December" Then 
     theMonth = 12 
    End If 

    'Check manually for bad dates: 
    If InStr("2/4/6/9/11", CStr(theMonth)) Then 'a month with 30 or fewer days: 
     If theMonth <> 1 Then 'January ("1") is found in 11, but January is OK, it has 31 days... 
      If theDay = 31 Then 
       Cells(13, 9).Interior.ColorIndex = 38 
       theErr = theErr + 1 
      End If 
      If InStr("2", CStr(theMonth)) Then 'February, with either 28 or 29 days: 
       If theDay = 30 Then 
        Cells(13, 9).Interior.ColorIndex = 38 
        theErr = theErr + 1 
       ElseIf theDay = 29 Then 
        If theYear Mod 4 <> 0 Then 'not a leap year: 
         Cells(13, 9).Interior.ColorIndex = 38 
         theErr = theErr + 1 
        End If 
       End If 
      End If 
     End If 
    End If 

    'Give error message if date error picked up: 
    If theErr <> 0 Then 
     MsgBox "Please check your date", vbOKOnly, "getDate" 
     Exit Sub 
    End If 

    theCurrentDate = DateSerial(theYear, theMonth, theDay) 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub 

這有點冗長....但它確實有效，現在OS區域不會影響它。

Answer 1

您可以關閉錯誤處理並將創建的字符串日期分配給日期變量。

然後您可以檢查是否導致錯誤;如果是這樣，我們知道使用的日期不是真正的日期。

這應該適用於所有地區，因爲它不依賴於OS語言設置。

Sub getDate() 

    Dim checkDate As Date 

    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    theCurrentDate = theDay & " " & theMonth & " " & theYear 

    On Error Resume Next 
    checkDate = theCurrentDate 

    'highlight bad date: 
    If Err.Number > 0 Then 
     Cells(13, 9).Interior.ColorIndex = 38 
     Exit Sub 
    End If 

    On Error GoTo 0 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub