smirnvlad
Full Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim ccBDate As ContentControl, ccRDate As ContentControl, ccA As ContentControl
Dim ccRdf As String, ccBdf As String
Dim dB As Date, dR As Date
Select Case ContentControl.Tag
Case "дата регистрации", "дата рождения":
Set ccRDate = ThisDocument.SelectContentControlsByTag("дата регистрации").Item(1)
Set ccBDate = ThisDocument.SelectContentControlsByTag("дата рождения").Item(1)
Set ccA = ThisDocument.SelectContentControlsByTag("возраст при регистрации").Item(1)
ccRdf = ccRDate.DateDisplayFormat
ccBdf = ccBDate.DateDisplayFormat
On Error Resume Next
ccRDate.DateDisplayFormat = DateFormat()
ccBDate.DateDisplayFormat = ccRDate.DateDisplayFormat
dR = DateValue(ccRDate.Range.Text)
dB = DateValue(ccBDate.Range.Text)
yd = DateDiff("yyyy", dB, dR)
' Если нужна разница по годам без учета месяца и дня (не полных лет) удалить до следующего комментария
md = DateDiff("m", dB, DateAdd("m", -12 * yd, dR))
dd = DateDiff("d", dB, DateAdd("m", -12 * yd - md, dR))
If md = 0 Then
If dd < 0 Then
yd = yd - 1
End If
ElseIf md < 0 Then
yd = yd - 1
End If
' Если нужна разница по годам без учета месяца и дня (не полных лет) удалить до этого комментария
ccA.Range.Text = Str$(yd)
ccRDate.DateDisplayFormat = df
ccBDate.DateDisplayFormat = df
End Select
End Sub
|
Код:
Function DateFormat() As String
DateFormat = FormatDateTime(DateSerial(2003, 1, 2), vbShortDate)
DateFormat = Replace(DateFormat, "2003", "YYYY")
DateFormat = Replace(DateFormat, "03", "YY")
DateFormat = Replace(DateFormat, "01", "MM")
DateFormat = Replace(DateFormat, "1", "M")
DateFormat = Replace(DateFormat, "02", "dd")
DateFormat = Replace(DateFormat, "2", "d")
DateFormat = Replace(DateFormat, MonthName(1), "MMMM")
DateFormat = Replace(DateFormat, MonthName(1, True), "MMM")
End Function
|
|
