我想在 VBA ms-Word 上获取两个 Datepicker 的值并用 DateDiff 计算差值

Question

我想获取VBAms-Word上两个Datepicker的值，然后用DateDiff计算两个日期的差值并显示在文档上。我可以通过使用“ContentControl.Range.Text”来获取 Datepicker 的值，但是当我将它与 DateDiff 一起使用时会说“类型不匹配”。

 Sub Test1()
'
' Test1 Macro
'
'
Dim doc As Document
Set doc = Application.ActiveDocument

Dim CCtrl As String
CCtrl = "Date1"

Dim chkExt As Boolean
chkExt = False

Dim control As ContentControl
For Each control In doc.ContentControls
    If control.Tag = CCtrl Then
        chkExt = True
        Exit For
    End If
Next

If chkExt = False Then
    MsgBox "Nothing"
    Exit Sub
End If

Dim ChangeType As Date
ChangeType = control.Range.Text

Debug.Print IsDate(ChangeType)

End Sub

更新：我发现问题日期的显示会影响代码如果日期以这种方式显示工作正常 Normal Format

但如果以泰语格式显示则不起作用 Thai Format

那么有什么解决方法可以使显示为泰语格式，但它的值与正常值相同。

感谢我的朋友，我找到了解决方案，所以方法是拆分日期，然后在文档上以这种方式使用 DateDiff，日期仍然显示为泰语格式，但仍然获得了在 DateDiff 中使用的值这是对我有用的代码：

Sub Test1()
'
' Test1 Macro
'
'
Dim doc As Document
Set doc = Application.ActiveDocument

Dim CCtrl, CCtrl2 As String
CCtrl = "Date1"
CCtrl2 = "Date2"



Dim chkExt As Boolean
chkExt = False

Dim control As ContentControl
Dim control2 As ContentControl


    For Each control2 In doc.ContentControls
        If control2.Tag = CCtrl2 Then
        control2.DateDisplayFormat = "d ´´´´ bbbb"
         Dim Result1() As String
        Result1() = Split(control2.Range.Text)
        Dim MyClasses1 As New Collection
         MyClasses1.Add Item:="01", Key:="Á¡ÃÒ¤Á"
         MyClasses1.Add Item:="02", Key:="¡ØÁÀÒ¾Ñ¹"
         MyClasses1.Add Item:="03", Key:="ÁÕ¹Ò¤Á"
         MyClasses1.Add Item:="04", Key:="àÁÉÒÂ¹"
         MyClasses1.Add Item:="05", Key:="¾ÄÉÀÒ¤Á"
         MyClasses1.Add Item:="06", Key:="ÁÔ¶Ø¹ÒÂ¹"
         MyClasses1.Add Item:="07", Key:="¡Ã¡®Ò¤Á"
         MyClasses1.Add Item:="08", Key:="ÊÔ§ËÒ¤Á"
         MyClasses1.Add Item:="09", Key:="¡Ñ¹ÂÒÂ¹"
         MyClasses1.Add Item:="10", Key:="µØÅÒ¤Á"
         MyClasses1.Add Item:="11", Key:="¾ÄÈ¨Ô¡ÒÂ¹"
         MyClasses1.Add Item:="12", Key:="¸Ñ¹ÇÒ¤Á"
         Dim engDate1 As String
         engDate1 = Result1(0) & "/" & MyClasses1(Result1(1)) & "/" & Result1(2)
         Debug.Print IsDate(engDate1)
        Exit For
        End If
    Next



    For Each control In doc.ContentControls
        'check if there is a tag
        If control.Tag = CCtrl Then
        control.DateDisplayFormat = "d ´´´´ bbbb"
        
        'For spliting Date as 00 00 00
        Dim Result() As String
        Result() = Split(control.Range.Text)
        
        'Creating Keys
        Dim MyClasses As New Collection
         MyClasses.Add Item:="01", Key:="Á¡ÃÒ¤Á"
         MyClasses.Add Item:="02", Key:="¡ØÁÀÒ¾Ñ¹"
         MyClasses.Add Item:="03", Key:="ÁÕ¹Ò¤Á"
         MyClasses.Add Item:="04", Key:="àÁÉÒÂ¹"
         MyClasses.Add Item:="05", Key:="¾ÄÉÀÒ¤Á"
         MyClasses.Add Item:="06", Key:="ÁÔ¶Ø¹ÒÂ¹"
         MyClasses.Add Item:="07", Key:="¡Ã¡®Ò¤Á"
         MyClasses.Add Item:="08", Key:="ÊÔ§ËÒ¤Á"
         MyClasses.Add Item:="09", Key:="¡Ñ¹ÂÒÂ¹"
         MyClasses.Add Item:="10", Key:="µØÅÒ¤Á"
         MyClasses.Add Item:="11", Key:="¾ÄÈ¨Ô¡ÒÂ¹"
         MyClasses.Add Item:="12", Key:="¸Ñ¹ÇÒ¤Á"
        
        'Put together the Date
        Dim engDate As String
        engDate = Result(0) & "/" & MyClasses(Result(1)) & "/" & Result(2)
        Debug.Print IsDate(engDate)
        Exit For
        End If
    Next
     Dim ccdisplayDateDiff As ContentControl
     Dim displayDateDiff As String
     displayDateDiff = "displayDateDiff"
     For Each ccdisplayDateDiff In doc.ContentControls
        If ccdisplayDateDiff.Tag = displayDateDiff Then
         ccdisplayDateDiff.Range.Text = DateDiff("d", engDate, engDate1)
         Exit For
        End If
     Next
End Sub

ps。外星人的语言是泰语，无法显示，在 collection 中是泰语 language.Sorry 的月份，因为我的英语不好。

感谢大家的帮助:)

Answer 1

Sub Test1()
'
' Test1 Macro
'
'
Dim doc As Document
Set doc = Application.ActiveDocument

Dim CCtrl, CCtrl2 As String
CCtrl = "Date1"
CCtrl2 = "Date2"



Dim chkExt As Boolean
chkExt = False

Dim control As ContentControl
Dim control2 As ContentControl


    For Each control2 In doc.ContentControls
        If control2.Tag = CCtrl2 Then
        control2.DateDisplayFormat = "d ´´´´ bbbb"
         Dim Result1() As String
        Result1() = Split(control2.Range.Text)
        Dim MyClasses1 As New Collection
         MyClasses1.Add Item:="01", Key:="Á¡ÃÒ¤Á"
         MyClasses1.Add Item:="02", Key:="¡ØÁÀÒ¾Ñ¹"
         MyClasses1.Add Item:="03", Key:="ÁÕ¹Ò¤Á"
         MyClasses1.Add Item:="04", Key:="àÁÉÒÂ¹"
         MyClasses1.Add Item:="05", Key:="¾ÄÉÀÒ¤Á"
         MyClasses1.Add Item:="06", Key:="ÁÔ¶Ø¹ÒÂ¹"
         MyClasses1.Add Item:="07", Key:="¡Ã¡®Ò¤Á"
         MyClasses1.Add Item:="08", Key:="ÊÔ§ËÒ¤Á"
         MyClasses1.Add Item:="09", Key:="¡Ñ¹ÂÒÂ¹"
         MyClasses1.Add Item:="10", Key:="µØÅÒ¤Á"
         MyClasses1.Add Item:="11", Key:="¾ÄÈ¨Ô¡ÒÂ¹"
         MyClasses1.Add Item:="12", Key:="¸Ñ¹ÇÒ¤Á"
         Dim engDate1 As String
         engDate1 = Result1(0) & "/" & MyClasses1(Result1(1)) & "/" & Result1(2)
         Debug.Print IsDate(engDate1)
        Exit For
        End If
    Next



    For Each control In doc.ContentControls
        'check if there is a tag
        If control.Tag = CCtrl Then
        control.DateDisplayFormat = "d ´´´´ bbbb"
        
        'For spliting Date as 00 00 00
        Dim Result() As String
        Result() = Split(control.Range.Text)
        
        'Creating Keys
        Dim MyClasses As New Collection
         MyClasses.Add Item:="01", Key:="Á¡ÃÒ¤Á"
         MyClasses.Add Item:="02", Key:="¡ØÁÀÒ¾Ñ¹"
         MyClasses.Add Item:="03", Key:="ÁÕ¹Ò¤Á"
         MyClasses.Add Item:="04", Key:="àÁÉÒÂ¹"
         MyClasses.Add Item:="05", Key:="¾ÄÉÀÒ¤Á"
         MyClasses.Add Item:="06", Key:="ÁÔ¶Ø¹ÒÂ¹"
         MyClasses.Add Item:="07", Key:="¡Ã¡®Ò¤Á"
         MyClasses.Add Item:="08", Key:="ÊÔ§ËÒ¤Á"
         MyClasses.Add Item:="09", Key:="¡Ñ¹ÂÒÂ¹"
         MyClasses.Add Item:="10", Key:="µØÅÒ¤Á"
         MyClasses.Add Item:="11", Key:="¾ÄÈ¨Ô¡ÒÂ¹"
         MyClasses.Add Item:="12", Key:="¸Ñ¹ÇÒ¤Á"
        
        'Put together the Date
        Dim engDate As String
        engDate = Result(0) & "/" & MyClasses(Result(1)) & "/" & Result(2)
        Debug.Print IsDate(engDate)
        Exit For
        End If
    Next
     Dim ccdisplayDateDiff As ContentControl
     Dim displayDateDiff As String
     displayDateDiff = "displayDateDiff"
     For Each ccdisplayDateDiff In doc.ContentControls
        If ccdisplayDateDiff.Tag = displayDateDiff Then
         ccdisplayDateDiff.Range.Text = DateDiff("d", engDate, engDate1)
         Exit For
        End If
     Next
End Sub

Answer 2

您只需将日期区域设置和格式更改为英语，收集您的数据，然后将其更改回泰语即可实现此目的。

像这样：

Sub Test2()
    Dim doc As Document
    Set doc = Application.ActiveDocument

    Const CCtrl As String = "Date1"
    Const CCtrl2 As String = "Date2"
    Const displayDateDiff As String = "displayDateDiff"

    Dim control As ContentControl
    Dim ccdisplayDateDiff As ContentControl
    Dim engDate As String, engDate1 As String
    For Each control In doc.ContentControls
        Select Case control.Tag
        Case CCtrl, CCtrl2
            control.DateDisplayLocale = wdEnglishUS
            control.DateDisplayFormat = "MMMM d YYYY"
            
            If control.Tag = CCtrl Then
                engDate = control.Range.Text
            ElseIf control.Tag = CCtrl2 Then
                engDate1 = control.Range.Text
            End If
            
            control.DateDisplayLocale = wdThai
            control.DateDisplayFormat = "d ´´´´ bbbb"
        
        Case displayDateDiff
            Set ccdisplayDateDiff = control
        End Select
    Next
    
    If Not ccdisplayDateDiff Is Nothing Then ccdisplayDateDiff.Range.Text = DateDiff("d", engDate, engDate1)
    
End Sub

我想在 VBA ms-Word 上获取两个 Datepicker 的值并用 DateDiff 计算差值

I want to get the value of two Datepicker on VBA ms-Word and Calculate the difference with DateDiff

vba

datediff

ms-word

datepicker

word-contentcontrol