Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Напоминание о приближении даты - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Напоминание о приближении даты
VitLO Дата: Понедельник, 21.01.2019, 23:28 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Доброго вечера всем участникам. Прошу помощи в корректировке кода. Необходимо всплывающее напоминание о заканчивающихся сроках страховых полисов (за 5 дней до наступлентя и до момента пока дата не поменяется), все данные хранятся в файле "Карточка учета" на листе "Осаго", но напоминание хотелось бы что бы выскакивало при открытии другого файла. Нашла на форуме код, но не могу его доработать под себя( Помогите пожалуйста в реализации)

[vba]
Код
Sub DOSAGO()
Dim BD
Dim i&
Dim dtNow$
Dim dtPrev$
dtNow = Day(Date) & "." & Month(Date) &"." & Year(Date)
With Workbooks("C:\Учет страховых полисов\Карточка учета.xlsm").Sheets("ОСАГО") ' файл где хранятся данные
BD = .Range("d3:d" & .[d65535].End(xlUp).Row)
End With
For i = 2 To UBound(BD)
dtPrev = Day(BD(i, 1)) & "." &Month(BD(i, 1)) & "." & Year(BD(i, 1))
dtRazn = DateDiff("d", dtNow, dtPrev)
If dtRazn <= 3 And dtRazn >= 0Then
MsgBox "Через " & dtRazn &" дн. заканчивается страховой полис ОСАГО на автомобиль " & Cells(i + 1, 2) & " регистрационный номер " & Cells(i +1, 1)
End If
Next
End Sub
[/vba]
К сообщению приложен файл: 1331619.xlsx (9.8 Kb)


Сообщение отредактировал VitLO - Понедельник, 21.01.2019, 23:30
 
Ответить
СообщениеДоброго вечера всем участникам. Прошу помощи в корректировке кода. Необходимо всплывающее напоминание о заканчивающихся сроках страховых полисов (за 5 дней до наступлентя и до момента пока дата не поменяется), все данные хранятся в файле "Карточка учета" на листе "Осаго", но напоминание хотелось бы что бы выскакивало при открытии другого файла. Нашла на форуме код, но не могу его доработать под себя( Помогите пожалуйста в реализации)

[vba]
Код
Sub DOSAGO()
Dim BD
Dim i&
Dim dtNow$
Dim dtPrev$
dtNow = Day(Date) & "." & Month(Date) &"." & Year(Date)
With Workbooks("C:\Учет страховых полисов\Карточка учета.xlsm").Sheets("ОСАГО") ' файл где хранятся данные
BD = .Range("d3:d" & .[d65535].End(xlUp).Row)
End With
For i = 2 To UBound(BD)
dtPrev = Day(BD(i, 1)) & "." &Month(BD(i, 1)) & "." & Year(BD(i, 1))
dtRazn = DateDiff("d", dtNow, dtPrev)
If dtRazn <= 3 And dtRazn >= 0Then
MsgBox "Через " & dtRazn &" дн. заканчивается страховой полис ОСАГО на автомобиль " & Cells(i + 1, 2) & " регистрационный номер " & Cells(i +1, 1)
End If
Next
End Sub
[/vba]

Автор - VitLO
Дата добавления - 21.01.2019 в 23:28
krosav4ig Дата: Вторник, 22.01.2019, 02:13 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте [vba]
Код
Option Explicit
Sub Auto_open()
    Dim wb As Workbook, bClosed As Boolean, ar As Range, c As Range, dtRazn%, s$, msg$
    On Error Resume Next
    Set wb = Workbooks("Карточка учета.xlsm")
    On Error GoTo 0
    If wb Is Nothing Then
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open("C:\Учет страховых полисов\Карточка учета.xlsm")
        wb.Windows(1).Visible = 0
        Application.ScreenUpdating = True
        bClosed = True
    End If
    
    For Each ar In ['[Карточка учета.xlsm]ОСАГО'!D:D].SpecialCells(2, 1).Areas
        For Each c In ar.Cells
            dtRazn = c - Date
            s = ""
            Select Case dtRazn
                Case Is < 0: s = "На " & Abs(dtRazn) & "дн. просрочен "
                Case 0: s = "Сегодня заканчивается "
                Case Is <= 5: s = "Через " & dtRazn & " дн. заканчивается "
            End Select
            If s <> "" Then msg = msg & IIf(msg <> "", vbCrLf, "") & s & _
                "страховой полис ОСАГО на автомобиль " & c.Offset(, -2) & _
                " регистрационный номер " & c.Offset(, -3)
        Next
    Next
    If msg <> "" Then MsgBox msg: Debug.Print msg
    If bClosed Then wb.Close False
End Sub
[/vba]
К сообщению приложен файл: 1331619.xlsm (16.7 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 22.01.2019, 23:29
 
Ответить
СообщениеЗдравствуйте [vba]
Код
Option Explicit
Sub Auto_open()
    Dim wb As Workbook, bClosed As Boolean, ar As Range, c As Range, dtRazn%, s$, msg$
    On Error Resume Next
    Set wb = Workbooks("Карточка учета.xlsm")
    On Error GoTo 0
    If wb Is Nothing Then
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open("C:\Учет страховых полисов\Карточка учета.xlsm")
        wb.Windows(1).Visible = 0
        Application.ScreenUpdating = True
        bClosed = True
    End If
    
    For Each ar In ['[Карточка учета.xlsm]ОСАГО'!D:D].SpecialCells(2, 1).Areas
        For Each c In ar.Cells
            dtRazn = c - Date
            s = ""
            Select Case dtRazn
                Case Is < 0: s = "На " & Abs(dtRazn) & "дн. просрочен "
                Case 0: s = "Сегодня заканчивается "
                Case Is <= 5: s = "Через " & dtRazn & " дн. заканчивается "
            End Select
            If s <> "" Then msg = msg & IIf(msg <> "", vbCrLf, "") & s & _
                "страховой полис ОСАГО на автомобиль " & c.Offset(, -2) & _
                " регистрационный номер " & c.Offset(, -3)
        Next
    Next
    If msg <> "" Then MsgBox msg: Debug.Print msg
    If bClosed Then wb.Close False
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 22.01.2019 в 02:13
VitLO Дата: Вторник, 22.01.2019, 08:20 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо большое. Подскажите пожалуйста этот код нужно поместить в книгу при открытии которой я хочу что бы появлялось сообщение так? И подсвечивает строку For Each ar In [[Карточка учета.xlsm]ОСАГО!D:D].SpecialCells(2, 1).Areas Выдает ОШИБКУ object required
 
Ответить
СообщениеСпасибо большое. Подскажите пожалуйста этот код нужно поместить в книгу при открытии которой я хочу что бы появлялось сообщение так? И подсвечивает строку For Each ar In [[Карточка учета.xlsm]ОСАГО!D:D].SpecialCells(2, 1).Areas Выдает ОШИБКУ object required

Автор - VitLO
Дата добавления - 22.01.2019 в 08:20
krosav4ig Дата: Вторник, 22.01.2019, 08:32 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
VitLO, забыл кавычки, исправил в своем посте, должно быть так [vba]
Код
For Each ar In ['[Карточка учета.xlsm]ОСАГО'!D:D].SpecialCells(2, 1).Areas
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеVitLO, забыл кавычки, исправил в своем посте, должно быть так [vba]
Код
For Each ar In ['[Карточка учета.xlsm]ОСАГО'!D:D].SpecialCells(2, 1).Areas
[/vba]

Автор - krosav4ig
Дата добавления - 22.01.2019 в 08:32
VitLO Дата: Вторник, 22.01.2019, 09:27 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Исправила, работает отлично, спасибо.


Сообщение отредактировал VitLO - Вторник, 22.01.2019, 18:05
 
Ответить
СообщениеИсправила, работает отлично, спасибо.

Автор - VitLO
Дата добавления - 22.01.2019 в 09:27
VitLO Дата: Вторник, 22.01.2019, 20:31 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Подскажите пожалуйста, что нужно поменять в строчке Case Is <= 5: s = "Через " & dtRazn & " дн. заканчивается " чтобы он показывал сообщение только за 5 дней до наступления даты, а то при таком условии он пишет и 360 дней осталось до окончания?
 
Ответить
СообщениеПодскажите пожалуйста, что нужно поменять в строчке Case Is <= 5: s = "Через " & dtRazn & " дн. заканчивается " чтобы он показывал сообщение только за 5 дней до наступления даты, а то при таком условии он пишет и 360 дней осталось до окончания?

Автор - VitLO
Дата добавления - 22.01.2019 в 20:31
VitLO Дата: Вторник, 22.01.2019, 21:02 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Все спасибо) Я разобралась hands hands hands
 
Ответить
СообщениеВсе спасибо) Я разобралась hands hands hands

Автор - VitLO
Дата добавления - 22.01.2019 в 21:02
VitLO Дата: Четверг, 24.01.2019, 15:34 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте я снова прошу Вашей помощи. Использовала Ваш код который запускается при открытии книги "учет автотранспорта", всплывает 2 msgbox поочередно с данными из разных листов книги "карточки учета". Вчера все работало отлично, сегодня утром перестал работать второй msgbox, а сейчас оба выдают ошибку( вот теперь не могу понять что его перестало устраивать
К сообщению приложен файл: 7155748.xlsm (83.3 Kb) · 8809970.xlsm (25.1 Kb)
 
Ответить
СообщениеЗдравствуйте я снова прошу Вашей помощи. Использовала Ваш код который запускается при открытии книги "учет автотранспорта", всплывает 2 msgbox поочередно с данными из разных листов книги "карточки учета". Вчера все работало отлично, сегодня утром перестал работать второй msgbox, а сейчас оба выдают ошибку( вот теперь не могу понять что его перестало устраивать

Автор - VitLO
Дата добавления - 24.01.2019 в 15:34
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!