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 | |