Excel VBA 날짜 선택 도구 문제

도움을 받으실 수 있으면 좋겠습니다. Excel 시트에 날짜가 입력 된 방식을 표준화하고 싶었 기 때문에 H 열에 날짜 선택기가 나타납니다. 내가 직면 한 문제는 더블린에 기반을 둔 어느 팀이든 셀 H10에서 H 열의 셀을 클릭하면 날짜 선택 도구가 팝업되고 원하는 날짜를 기록하기 때문입니다. 2011 년 5 월 11 일 또는 "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, 'MM/DD/YYYY') 위에 날짜를 기록하는 동안. Calendarcontrol을 실제 달력 컨트롤의 이름으로 바꿉니다. – 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

클릭 이벤트에 대한 모든 개인용 서브 프로그램에서 activecell을 형식화하십시오. 예를 들어

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

안녕하세요 Kelaref 불행히도 도움을 줄 수없는 시간을내어 주셔서 감사합니다. My Finish 팀 메이트는 방금 날짜 형식이 05/12/17이 아니라 5.12.17과 함께 반환된다는 사실을 알게되었습니다. 다른 방법이 있습니까? –

cDate를 편집하여 – Kelaref

Kelaref이 문제를 해결해 주셔서 감사합니다.핀란드에서 일하는 유일한 나라는 핀란드지만, 다른 모든 국가에서는 핀란드가 일하고있는 것으로 보입니다. 그래서 나는 당신의 대답을 받아들이는 것이 공평하다고 생각했습니다. 다시 도움을 주셔서 감사합니다. –

Excel VBA 날짜 선택 도구 문제

답변

관련 문제