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

Вход

Регистрация

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

 

= Мир MS Excel/Всплывающая подсказка - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Всплывающая подсказка (Макросы/Sub)
Всплывающая подсказка
ekut Дата: Пятница, 09.09.2022, 11:38 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 195
Репутация: 3 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте, уважаемые Екселисты!!! Помогите, пожалуйста, сделать Всплывающую подсказку, в которой будут отражаться ФИО ( столбец В) и даты, выделенные красным цветом (используем столбец G J N R U). Благодарю заранее!!!!!
К сообщению приложен файл: 123.xlsm (47.3 Kb)
 
Ответить
СообщениеЗдравствуйте, уважаемые Екселисты!!! Помогите, пожалуйста, сделать Всплывающую подсказку, в которой будут отражаться ФИО ( столбец В) и даты, выделенные красным цветом (используем столбец G J N R U). Благодарю заранее!!!!!

Автор - ekut
Дата добавления - 09.09.2022 в 11:38
RAN Дата: Пятница, 09.09.2022, 12:36 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("G:G,J:J,N:N,R:R,U:U")) Is Nothing Then
        If Target(1).DisplayFormat.Interior.ColorIndex <> xlNone Then
            MsgBox Cells(Target.Row, 2).MergeArea(1).Value
        End If
    End If
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("G:G,J:J,N:N,R:R,U:U")) Is Nothing Then
        If Target(1).DisplayFormat.Interior.ColorIndex <> xlNone Then
            MsgBox Cells(Target.Row, 2).MergeArea(1).Value
        End If
    End If
End Sub
[/vba]

Автор - RAN
Дата добавления - 09.09.2022 в 12:36
NikitaDvorets Дата: Пятница, 09.09.2022, 12:51 | Сообщение № 3
Группа: Авторы
Ранг: Ветеран
Сообщений: 548
Репутация: 123 ±
Замечаний: 0% ±

Excel 2019
ekut, добрый день.
Вариант: всплывающее сообщение при активации листа "График инструктажа"
К сообщению приложен файл: TEST-206_____09.xlsm (52.9 Kb)


Сообщение отредактировал NikitaDvorets - Пятница, 09.09.2022, 15:00
 
Ответить
Сообщениеekut, добрый день.
Вариант: всплывающее сообщение при активации листа "График инструктажа"

Автор - NikitaDvorets
Дата добавления - 09.09.2022 в 12:51
ekut Дата: Пятница, 09.09.2022, 17:32 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 195
Репутация: 3 ±
Замечаний: 0% ±

Excel 2007
Уважаемые Екселисты, спасибо огромное! Видимо не правильно обозначила задачу! При открытии файла у меня уже всплывает подсказка! Но она у меня не учитывает соседние столбцы. Мне бы ее откорректировать!
 
Ответить
СообщениеУважаемые Екселисты, спасибо огромное! Видимо не правильно обозначила задачу! При открытии файла у меня уже всплывает подсказка! Но она у меня не учитывает соседние столбцы. Мне бы ее откорректировать!

Автор - ekut
Дата добавления - 09.09.2022 в 17:32
ekut Дата: Суббота, 10.09.2022, 03:23 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 195
Репутация: 3 ±
Замечаний: 0% ±

Excel 2007
Макрос
[vba]
Код
[color=black][l]Private Sub Workbook_Open() 'Всплывающая подсказка
Dim sh As Worksheet ', FIO$,
Dim Dat As Date, lrow&, i&, s$
Set sh = ThisWorkbook.Worksheets("График инструктажа")
Dim DateBegin As Date
Dim DateEnd As Date
  DateBegin = DateSerial(Year(Date), Month(Date), 1)            'первый день текущего месяца
  DateEnd = DateSerial(Year(Date), Month(Date) + 1, 1) - 1      'последний день текущего месяца
'    Dat = Date + 30
        With sh
          lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For i = 4 To lrow
              If .Cells(i, 2).Value <> "" Then
                If .Cells(i, 7).Value >= DateBegin And .Cells(i, 7).Value <= DateEnd Then
                   s = s & Chr(10) & .Cells(i, 2).Value & vbTab & vbTab & vbTab & vbTab & .Cells(i, 7).Value
                End If
              End If
            Next i
        End With
    UserForm1.Show 0
    UserForm1.Label1.Caption = s
    UserForm1.ScrollHeight = UserForm1.Label1.Height + 20
    UserForm1.Height = Application.Min(UserForm1.Label1.Height + 40, 500)
    'MsgBox s
End Sub

[/l][/color]
[/vba]


Сообщение отредактировал ekut - Суббота, 10.09.2022, 03:33
 
Ответить
СообщениеМакрос
[vba]
Код
[color=black][l]Private Sub Workbook_Open() 'Всплывающая подсказка
Dim sh As Worksheet ', FIO$,
Dim Dat As Date, lrow&, i&, s$
Set sh = ThisWorkbook.Worksheets("График инструктажа")
Dim DateBegin As Date
Dim DateEnd As Date
  DateBegin = DateSerial(Year(Date), Month(Date), 1)            'первый день текущего месяца
  DateEnd = DateSerial(Year(Date), Month(Date) + 1, 1) - 1      'последний день текущего месяца
'    Dat = Date + 30
        With sh
          lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For i = 4 To lrow
              If .Cells(i, 2).Value <> "" Then
                If .Cells(i, 7).Value >= DateBegin And .Cells(i, 7).Value <= DateEnd Then
                   s = s & Chr(10) & .Cells(i, 2).Value & vbTab & vbTab & vbTab & vbTab & .Cells(i, 7).Value
                End If
              End If
            Next i
        End With
    UserForm1.Show 0
    UserForm1.Label1.Caption = s
    UserForm1.ScrollHeight = UserForm1.Label1.Height + 20
    UserForm1.Height = Application.Min(UserForm1.Label1.Height + 40, 500)
    'MsgBox s
End Sub

[/l][/color]
[/vba]

Автор - ekut
Дата добавления - 10.09.2022 в 03:23
NikitaDvorets Дата: Суббота, 10.09.2022, 15:24 | Сообщение № 6
Группа: Авторы
Ранг: Ветеран
Сообщений: 548
Репутация: 123 ±
Замечаний: 0% ±

Excel 2019
ekut, в макрос добавляем второй цикл и переменную для произвольного числа столбцов.
К сообщению приложен файл: TEST-206_____10.xlsm (56.6 Kb)
 
Ответить
Сообщениеekut, в макрос добавляем второй цикл и переменную для произвольного числа столбцов.

Автор - NikitaDvorets
Дата добавления - 10.09.2022 в 15:24
ekut Дата: Воскресенье, 11.09.2022, 08:28 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 195
Репутация: 3 ±
Замечаний: 0% ±

Excel 2007
Nikita, здравствуйте!!! Спасибо большое за ответ! Но в Вашем варианте есть небольшие погрешности: в подсказке формируются только значения за этот месяц, а просроченных нет. И еще Вы ушли от моей всплывающей подсказки при включении!! Ваша срабатывает при переключении листов, а всплывающая подсказка моя не работает ( на мой взгляд это удобнее) Спасибо заранее.
К сообщению приложен файл: 5637144.png (163.1 Kb)
 
Ответить
СообщениеNikita, здравствуйте!!! Спасибо большое за ответ! Но в Вашем варианте есть небольшие погрешности: в подсказке формируются только значения за этот месяц, а просроченных нет. И еще Вы ушли от моей всплывающей подсказки при включении!! Ваша срабатывает при переключении листов, а всплывающая подсказка моя не работает ( на мой взгляд это удобнее) Спасибо заранее.

Автор - ekut
Дата добавления - 11.09.2022 в 08:28
NikitaDvorets Дата: Понедельник, 12.09.2022, 10:30 | Сообщение № 8
Группа: Авторы
Ранг: Ветеран
Сообщений: 548
Репутация: 123 ±
Замечаний: 0% ±

Excel 2019
ekut, добрый день.
Пришлось заменить заливку просроченных на желтую, сделать цикл по избранным столбцам и заменить макрос книги при открытии.
К сообщению приложен файл: TEST-206_____12.xlsm (54.8 Kb)


Сообщение отредактировал NikitaDvorets - Понедельник, 12.09.2022, 12:39
 
Ответить
Сообщениеekut, добрый день.
Пришлось заменить заливку просроченных на желтую, сделать цикл по избранным столбцам и заменить макрос книги при открытии.

Автор - NikitaDvorets
Дата добавления - 12.09.2022 в 10:30
ekut Дата: Понедельник, 12.09.2022, 17:46 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 195
Репутация: 3 ±
Замечаний: 0% ±

Excel 2007
Nikita, спасибо огромноеееееее!!!
 
Ответить
СообщениеNikita, спасибо огромноеееееее!!!

Автор - ekut
Дата добавления - 12.09.2022 в 17:46
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Всплывающая подсказка (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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