Excel VBA日付ピッカー問題

お手数ですがお手数ですが、 Excelのシートに日付がどのように入力されたのかを標準化したいので、H列にポップアップする日付ピッカーがあります。私が直面する問題は、ダブリンに拠点を置く私のチームのいずれかが、セルH10から列Hのセルをクリックすると、日付ピッカーがポップアップし、05/11/2017または「mm/DD/YYYY」今Excel VBA日付ピッカー問題

デンマークやフィンランドなどの他の国での私のチームメイトは、H10の下のセルをクリックしてください日付形式が返され.5.11.17それは2017年5月11日フォーマット

を返されていない場合

スクリーンショット1では、私の問題の視覚的な表現を見ることができます。

ポップアップカレンダーのコードを使用すると、スクリーンショットで見ることができるように、2つのモジュールである2

マイコードは、いずれかがこの問題を解決することができ、以下のでしょうか？

は、いつものように任意およびすべてのヘルプが大幅

を高く評価している私は、私は完全にそれを理解していないオンラインコードからこの日付ピッカーを活用しました。

しかし、私のコードはスクリーンショット2のクラスモジュールの第二モジュールから

コードを下回っているが、ここで

Option Explicit 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    'check cells for desired format to trigger the calendarfrm.show routine 
    'otherwise exit the sub 
    Dim DateFormats, DF 
    DateFormats = Array("m/d/yy;@", "mm/dd/yyyy") 
    For Each DF In DateFormats 
     If DF = Target.NumberFormat Then 
      If CalendarFrm.HelpLabel.Caption <> "" Then 
       CalendarFrm.Height = 191 + CalendarFrm.HelpLabel.Height 
      Else: CalendarFrm.Height = 191 
       CalendarFrm.Show 
      End If 
     End If 
    Next 
End Sub

とカレンダーのフォームからコードされ、ここで

VERSION 5.00 
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CalendarFrm 
    Caption   = "Calendar Control" 
    ClientHeight = 3690 
    ClientLeft  = 45 
    ClientTop  = 360 
    ClientWidth  = 3960 
    OleObjectBlob = "CalendarFrm.frx":0000 
    StartUpPosition = 1 'CenterOwner 
End 
Attribute VB_Name = "CalendarFrm" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 



Option Explicit 
    Dim ThisDay As Date 
    Dim ThisYear, ThisMth As Date 
    Dim CreateCal As Boolean 
    Dim i As Integer 
Private Sub UserForm_Initialize() 
    Application.EnableEvents = False 
    'starts the form on todays date 
    ThisDay = Date 
    ThisMth = Format(ThisDay, "mm") 
    ThisYear = Format(ThisDay, "yyyy") 
    For i = 1 To 12 
     CB_Mth.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm") 
    Next 
    CB_Mth.ListIndex = Format(Date, "mm") - Format(Date, "mm") 
    For i = -20 To 50 
     If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else CB_Yr.AddItem _ 
      Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy") 
    Next 
    CB_Yr.ListIndex = 21 
    'Builds the calendar with todays date 
    CalendarFrm.Width = CalendarFrm.Width 
    CreateCal = True 
    Call Build_Calendar 
    Application.EnableEvents = True 
End Sub 
Private Sub CB_Mth_Change() 
    'rebuilds the calendar when the month is changed by the user 
    Build_Calendar 
End Sub 
Private Sub CB_Yr_Change() 
    'rebuilds the calendar when the year is changed by the user 
    Build_Calendar 
End Sub 
Private Sub Build_Calendar() 
    'the routine that actually builds the calendar each time 
    If CreateCal = True Then 
    CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value 
    'sets the focus for the todays date button 
    CommandButton1.SetFocus 
    For i = 1 To 42 
     If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then 
      Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ 
       ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d") 
      Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ 
       ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") 
     ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then 
      Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _ 
       & "/1/" & (CB_Yr.Value))), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d") 
      Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ 
       ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") 
     End If 
     If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ 
     ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then 
      If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018 '&H80000010 
      Controls("D" & (i)).Font.Bold = True 
     If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _ 
      ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisDay, "m/d/yy") Then Controls("D" & (i)).SetFocus 
     Else 
      If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F 
      Controls("D" & (i)).Font.Bold = False 
     End If 
    Next 
    End If 
End Sub 
Private Sub D1_Click() 
    'this sub and the ones following represent the buttons for days on the form 
    'retrieves the current value of the individual controltiptext and 
    'places it in the active cell 
    ActiveCell.Value = D1.ControlTipText 
    Unload Me 
    'after unload you can call a different userform to continue data entry 
    'uncomment this line and add a userform named UserForm2 
    'Userform2.Show 

End Sub 
Private Sub D2_Click() 
    ActiveCell.Value = D2.ControlTipText 
    Unload Me 

End Sub 
Private Sub D3_Click() 
    ActiveCell.Value = D3.ControlTipText 
    Unload Me 

End Sub 
Private Sub D4_Click() 
    ActiveCell.Value = D4.ControlTipText 
    Unload Me 

End Sub 
Private Sub D5_Click() 
    ActiveCell.Value = D5.ControlTipText 
    Unload Me 

End Sub 
Private Sub D6_Click() 
    ActiveCell.Value = D6.ControlTipText 
    Unload Me 

End Sub 
Private Sub D7_Click() 
    ActiveCell.Value = D7.ControlTipText 
    Unload Me 

End Sub 
Private Sub D8_Click() 
    ActiveCell.Value = D8.ControlTipText 
    Unload Me 

End Sub 
Private Sub D9_Click() 
    ActiveCell.Value = D9.ControlTipText 
    Unload Me 

End Sub 
Private Sub D10_Click() 
    ActiveCell.Value = D10.ControlTipText 
    Unload Me 

End Sub 
Private Sub D11_Click() 
    ActiveCell.Value = D11.ControlTipText 
    Unload Me 

End Sub 
Private Sub D12_Click() 
    ActiveCell.Value = D12.ControlTipText 
    Unload Me 

End Sub 
Private Sub D13_Click() 
    ActiveCell.Value = D13.ControlTipText 
    Unload Me 

End Sub 
Private Sub D14_Click() 
    ActiveCell.Value = D14.ControlTipText 
    Unload Me 

End Sub 
Private Sub D15_Click() 
    ActiveCell.Value = D15.ControlTipText 
    Unload Me 

End Sub 
Private Sub D16_Click() 
    ActiveCell.Value = D16.ControlTipText 
    Unload Me 

End Sub 
Private Sub D17_Click() 
    ActiveCell.Value = D17.ControlTipText 
    Unload Me 

End Sub 
Private Sub D18_Click() 
    ActiveCell.Value = D18.ControlTipText 
    Unload Me 

End Sub 
Private Sub D19_Click() 
    ActiveCell.Value = D19.ControlTipText 
    Unload Me 

End Sub 
Private Sub D20_Click() 
    ActiveCell.Value = D20.ControlTipText 
    Unload Me 

End Sub 
Private Sub D21_Click() 
    ActiveCell.Value = D21.ControlTipText 
    Unload Me 

End Sub 
Private Sub D22_Click() 
    ActiveCell.Value = D22.ControlTipText 
    Unload Me 

End Sub 
Private Sub D23_Click() 
    ActiveCell.Value = D23.ControlTipText 
    Unload Me 

End Sub 
Private Sub D24_Click() 
    ActiveCell.Value = D24.ControlTipText 
    Unload Me 

End Sub 
Private Sub D25_Click() 
    ActiveCell.Value = D25.ControlTipText 
    Unload Me 

End Sub 
Private Sub D26_Click() 
    ActiveCell.Value = D26.ControlTipText 
    Unload Me 

End Sub 
Private Sub D27_Click() 
    ActiveCell.Value = D27.ControlTipText 
    Unload Me 

End Sub 
Private Sub D28_Click() 
    ActiveCell.Value = D28.ControlTipText 
    Unload Me 

End Sub 
Private Sub D29_Click() 
    ActiveCell.Value = D29.ControlTipText 
    Unload Me 

End Sub 
Private Sub D30_Click() 
    ActiveCell.Value = D30.ControlTipText 
    Unload Me 

End Sub 
Private Sub D31_Click() 
    ActiveCell.Value = D31.ControlTipText 
    Unload Me 

End Sub 
Private Sub D32_Click() 
    ActiveCell.Value = D32.ControlTipText 
    Unload Me 

End Sub 
Private Sub D33_Click() 
    ActiveCell.Value = D33.ControlTipText 
    Unload Me 

End Sub 
Private Sub D34_Click() 
    ActiveCell.Value = D34.ControlTipText 
    Unload Me 

End Sub 
Private Sub D35_Click() 
    ActiveCell.Value = D35.ControlTipText 
    Unload Me 

End Sub 
Private Sub D36_Click() 
    ActiveCell.Value = D36.ControlTipText 
    Unload Me 

End Sub 
Private Sub D37_Click() 
    ActiveCell.Value = D37.ControlTipText 
    Unload Me 

End Sub 
Private Sub D38_Click() 
    ActiveCell.Value = D38.ControlTipText 
    Unload Me 

End Sub 
Private Sub D39_Click() 
    ActiveCell.Value = D39.ControlTipText 
    Unload Me 

End Sub 
Private Sub D40_Click() 
    ActiveCell.Value = D40.ControlTipText 
    Unload Me 

End Sub 
Private Sub D41_Click() 
    ActiveCell.Value = D41.ControlTipText 
    Unload Me 

End Sub 
Private Sub D42_Click() 
    ActiveCell.Value = D42.ControlTipText 
    Unload Me 

End Sub

画面ですショット1

Sc reen Shot 2

出典

2017-05-12 Philip Connell

シートトライフォーマット（CalendarControl.Value、 "YYYY/MM/DD"）に戻って日付を書きながら。 Calendarcontrolを実際のカレンダーコントロールの名前に置き換えます。 – sktneer

こんにちはSktneer時間を割いていただきありがとうございます。私はカレンダーコントロールを変更すると、カレンダーコントロールが "m/d/yy"の形式で、まだ5/12/17を返すと思います。他の国のチームメイトから05.12.17の日付形式を取得しています。また、私は非常に感謝して努力をありがとう –

ここでの問題は、あなたのカレンダーフォームの日付形式があなたのユーザーのWindowsの日付設定と一致しないセルにテキストとして日付形式をプッシュしていることです。 Excelはフォーマットされたテキストを実際の日付に変換しようとしますが、31/12/2017や20/31/2017のように失敗する場合もあります。参照してください：http://oaltd.co.uk/ExcelProgRef/Default.htm – jkpieterse

クリックイベントのためにすべてのプライベートサブにアクティブセルをフォーマットします。例えば

：

Private Sub D6_Click() 
    ActiveCell.Value = cDate(D35.ControlTipText) 
    activecell.NumberFormat = "mm/dd/yyyy" 
    Unload Me 
End Sub

出典

2017-05-12 09:28:07 Kelaref

こんにちはケラレフ残念なことに、役に立たなかったように手伝ってくださったあなたの試みに感謝します。 My Finishチームメイトは、日付形式が5.12.17で、05/12/17ではないことを私に示しました。別の方法がありますか？ –

cDateを編集しました – Kelaref

Kelarefこの問題を解決するために時間を割いてくれてどうもありがとう。それが働かない唯一の国はフィンランドですが、他のすべての国では働いているようです。だからあなたの答えを受け入れることだけが公正だと思った。もう一度、助けてくれてありがとう。 –

Excel VBA日付ピッカー問題

答えて

関連する問題