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

Вход

Регистрация

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

 

= Мир MS Excel/Журнал событий - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Журнал событий (Макросы/Sub)
Журнал событий
Мурад Дата: Среда, 12.08.2015, 15:20 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Добрый день! Помогите)) Как можно реализовать в нашей любимой программе отображение информационного окошка с журналом событий по каждому документу? Я вставил в ячейках R7:R9 формулы для показа последнего события по конкретному документу. Под таблицей указал, о каком журнале событий идет речь. Спасибо заранее за проявленное внимание к данной теме!
К сообщению приложен файл: __-.xlsx (52.9 Kb)
 
Ответить
СообщениеДобрый день! Помогите)) Как можно реализовать в нашей любимой программе отображение информационного окошка с журналом событий по каждому документу? Я вставил в ячейках R7:R9 формулы для показа последнего события по конкретному документу. Под таблицей указал, о каком журнале событий идет речь. Спасибо заранее за проявленное внимание к данной теме!

Автор - Мурад
Дата добавления - 12.08.2015 в 15:20
Мурад Дата: Среда, 12.08.2015, 17:58 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Может мне пример попроще выложить, если вас сбивают с толку длинные таблицы?
Допустим, фамилии Иванов, Петров, Сидоров. Под каждой фамилией числа от 1 до 5. При нажатии на фамилию выходит сообщение:
1
2
3
4
5
 
Ответить
СообщениеМожет мне пример попроще выложить, если вас сбивают с толку длинные таблицы?
Допустим, фамилии Иванов, Петров, Сидоров. Под каждой фамилией числа от 1 до 5. При нажатии на фамилию выходит сообщение:
1
2
3
4
5

Автор - Мурад
Дата добавления - 12.08.2015 в 17:58
Udik Дата: Среда, 12.08.2015, 18:35 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Вы хотите щелчком по ячейке диапазона вызвать MsgBox?
[vba]
Код

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call test(Target)
End Sub

Public Sub test(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A2:A100")) Is Nothing Then MsgBox "Шо ви хотите?"

End Sub

[/vba]
[p.s.]Сообщение можно любое составить
К сообщению приложен файл: eAI.xlsm (14.8 Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Среда, 12.08.2015, 18:38
 
Ответить
СообщениеВы хотите щелчком по ячейке диапазона вызвать MsgBox?
[vba]
Код

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call test(Target)
End Sub

Public Sub test(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A2:A100")) Is Nothing Then MsgBox "Шо ви хотите?"

End Sub

[/vba]
[p.s.]Сообщение можно любое составить

Автор - Udik
Дата добавления - 12.08.2015 в 18:35
nilem Дата: Среда, 12.08.2015, 19:52 | Сообщение № 4
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
наверное, как-то так:
[vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("R7:R100")) Is Nothing Then Exit Sub
Cancel = True
Dim s$
With Sheets("История согласования").Rows(Target.Row)
     '21.01.2015 Заявка утвержд. Рабочая комиссия
     s = .Cells(7) & " " & .Cells(4) & " " & .Cells(8) & " " & .Cells(5)
     '23.01.2015 Заявка согласов. Ходырев
     s = s & vbCrLf & .Cells(12) & " " & .Cells(9) & " " & .Cells(13) & " " & .Cells(10)
     '24.01.2015 Заявка согласов. Кучина
     s = s & vbCrLf & .Cells(17) & " " & .Cells(14) & " " & .Cells(18) & " " & .Cells(15)
     '26.01.2015 Проект договора согласов. Желтова
     s = s & vbCrLf & .Cells(22) & " " & .Cells(19) & " " & .Cells(23) & " " & .Cells(20)
     '27.01.2015 Проект договора согласов. Правовое Управление
     s = s & vbCrLf & .Cells(27) & " " & .Cells(24) & " " & .Cells(28) & " " & .Cells(25)
     '30.01.2015 Договор заключен Починок
     s = s & vbCrLf & .Cells(32) & " " & .Cells(29) & " " & .Cells(33) & " " & .Cells(30)
End With
MsgBox s, 64
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениенаверное, как-то так:
[vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("R7:R100")) Is Nothing Then Exit Sub
Cancel = True
Dim s$
With Sheets("История согласования").Rows(Target.Row)
     '21.01.2015 Заявка утвержд. Рабочая комиссия
     s = .Cells(7) & " " & .Cells(4) & " " & .Cells(8) & " " & .Cells(5)
     '23.01.2015 Заявка согласов. Ходырев
     s = s & vbCrLf & .Cells(12) & " " & .Cells(9) & " " & .Cells(13) & " " & .Cells(10)
     '24.01.2015 Заявка согласов. Кучина
     s = s & vbCrLf & .Cells(17) & " " & .Cells(14) & " " & .Cells(18) & " " & .Cells(15)
     '26.01.2015 Проект договора согласов. Желтова
     s = s & vbCrLf & .Cells(22) & " " & .Cells(19) & " " & .Cells(23) & " " & .Cells(20)
     '27.01.2015 Проект договора согласов. Правовое Управление
     s = s & vbCrLf & .Cells(27) & " " & .Cells(24) & " " & .Cells(28) & " " & .Cells(25)
     '30.01.2015 Договор заключен Починок
     s = s & vbCrLf & .Cells(32) & " " & .Cells(29) & " " & .Cells(33) & " " & .Cells(30)
End With
MsgBox s, 64
End Sub
[/vba]

Автор - nilem
Дата добавления - 12.08.2015 в 19:52
Мурад Дата: Четверг, 13.08.2015, 09:52 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
nilem, спасибо за труд! С имеющейся в файле информацией код работает отлично! Но стоило мне дописать новый этап в Истории согласования, компилятор сдался... Допустим, по второй заявке.. Постараюсь доработать Ваш код, чтобы высвечивались все этапы из листа Истории согласования.
 
Ответить
Сообщениеnilem, спасибо за труд! С имеющейся в файле информацией код работает отлично! Но стоило мне дописать новый этап в Истории согласования, компилятор сдался... Допустим, по второй заявке.. Постараюсь доработать Ваш код, чтобы высвечивались все этапы из листа Истории согласования.

Автор - Мурад
Дата добавления - 13.08.2015 в 09:52
Мурад Дата: Четверг, 13.08.2015, 09:59 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Udik, открыв Ваш файл, обнаружил пустой лист.. Нет данных, кроме кода в VBA
 
Ответить
СообщениеUdik, открыв Ваш файл, обнаружил пустой лист.. Нет данных, кроме кода в VBA

Автор - Мурад
Дата добавления - 13.08.2015 в 09:59
Мурад Дата: Четверг, 13.08.2015, 10:30 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
nilem, давайте доработаем Ваш код. Сделаем проверку по каждой строке:
1) Если дата передачи заполнена, а дата возврата не заполнена (номер столбца даты передачи - N), то показываем запись: N&" "&(N-2)&" направл. "&(N-1)
2) Если помимо даты передачи еще и заполнена дата возврата (номер столбца даты передачи - N), то показываем запись: (N+1)&" "&(N-2)&" "&(N+2)&" "&(N-1)
Цикл проверяет ячейки 6, 11, 16 (с шагом 5), до 56 включительно. Если имеется разрыв между этапами, т.е. в этапе 1 имеются сведения, во 2-4 этапах информации нет, а в 5 этапе сведения имеются снова, то пустые строки в журнале событий не показывать..
 
Ответить
Сообщениеnilem, давайте доработаем Ваш код. Сделаем проверку по каждой строке:
1) Если дата передачи заполнена, а дата возврата не заполнена (номер столбца даты передачи - N), то показываем запись: N&" "&(N-2)&" направл. "&(N-1)
2) Если помимо даты передачи еще и заполнена дата возврата (номер столбца даты передачи - N), то показываем запись: (N+1)&" "&(N-2)&" "&(N+2)&" "&(N-1)
Цикл проверяет ячейки 6, 11, 16 (с шагом 5), до 56 включительно. Если имеется разрыв между этапами, т.е. в этапе 1 имеются сведения, во 2-4 этапах информации нет, а в 5 этапе сведения имеются снова, то пустые строки в журнале событий не показывать..

Автор - Мурад
Дата добавления - 13.08.2015 в 10:30
Udik Дата: Четверг, 13.08.2015, 12:10 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Нет данных, кроме кода

Так естественно, я ж набросал код вызова MsgBox по щелчку ячейки. Необходимый текст думал сами составите.


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщение
Нет данных, кроме кода

Так естественно, я ж набросал код вызова MsgBox по щелчку ячейки. Необходимый текст думал сами составите.

Автор - Udik
Дата добавления - 13.08.2015 в 12:10
Мурад Дата: Четверг, 13.08.2015, 12:32 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Спасибо, nilem, доработал Ваш код:
[vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("R7:R100")) Is Nothing Then Exit Sub
Cancel = True
Dim s$, i As Integer
With Sheets("История согласования").Rows(Target.Row)
     For i = 6 To 56 Step 5
     If (.Cells(i) <> "") And (.Cells(i + 1) = "") Then
     s = s & .Cells(i) & " " & .Cells(i - 2) & " направл. " & .Cells(i - 1) & vbCrLf
     ElseIf (.Cells(i) <> "") And (.Cells(i + 1) <> "") Then
     s = s & .Cells(i + 1) & " " & .Cells(i - 2) & " " & .Cells(i + 2) & " " & .Cells(i - 1) & vbCrLf
     ElseIf (.Cells(i) = "") And (.Cells(i + 1) <> "") Then
     s = s & .Cells(i + 1) & " " & .Cells(i - 2) & " " & .Cells(i + 2) & " " & .Cells(i - 1) & vbCrLf
     End If
     Next
End With
MsgBox s, 64
End Sub
[/vba]
 
Ответить
СообщениеСпасибо, nilem, доработал Ваш код:
[vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("R7:R100")) Is Nothing Then Exit Sub
Cancel = True
Dim s$, i As Integer
With Sheets("История согласования").Rows(Target.Row)
     For i = 6 To 56 Step 5
     If (.Cells(i) <> "") And (.Cells(i + 1) = "") Then
     s = s & .Cells(i) & " " & .Cells(i - 2) & " направл. " & .Cells(i - 1) & vbCrLf
     ElseIf (.Cells(i) <> "") And (.Cells(i + 1) <> "") Then
     s = s & .Cells(i + 1) & " " & .Cells(i - 2) & " " & .Cells(i + 2) & " " & .Cells(i - 1) & vbCrLf
     ElseIf (.Cells(i) = "") And (.Cells(i + 1) <> "") Then
     s = s & .Cells(i + 1) & " " & .Cells(i - 2) & " " & .Cells(i + 2) & " " & .Cells(i - 1) & vbCrLf
     End If
     Next
End With
MsgBox s, 64
End Sub
[/vba]

Автор - Мурад
Дата добавления - 13.08.2015 в 12:32
nilem Дата: Четверг, 13.08.2015, 12:38 | Сообщение № 10
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
...компилятор сдался...

Компиляторы не сдаются! просто иногда они расслябляются :)
попробуйте так
[vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("R7:R100")) Is Nothing Then Exit Sub
Cancel = True
Dim x, s$, i&
x = Sheets("История согласования").Cells(Target.Row, 1).Resize(, 58).Value
For i = 6 To 56 Step 5
     If Len(x(1, i)) Then
         If Len(x(1, i + 1)) Then
             ' (N+1)&" "&(N-2)&" "&(N+2)&" "&(N-1)
             s = s & x(1, i + 1) & " " & x(1, i - 2) & " " & x(1, i + 2) & " " & x(1, i - 1) & vbCrLf
         Else
             'N & " " & (N-2) & " направл. " & (N-1)
             s = s & x(1, i) & " " & x(1, i - 2) & " направл. " & x(1, i - 1) & vbCrLf
         End If
     End If
Next i
MsgBox s, 64
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщение
...компилятор сдался...

Компиляторы не сдаются! просто иногда они расслябляются :)
попробуйте так
[vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("R7:R100")) Is Nothing Then Exit Sub
Cancel = True
Dim x, s$, i&
x = Sheets("История согласования").Cells(Target.Row, 1).Resize(, 58).Value
For i = 6 To 56 Step 5
     If Len(x(1, i)) Then
         If Len(x(1, i + 1)) Then
             ' (N+1)&" "&(N-2)&" "&(N+2)&" "&(N-1)
             s = s & x(1, i + 1) & " " & x(1, i - 2) & " " & x(1, i + 2) & " " & x(1, i - 1) & vbCrLf
         Else
             'N & " " & (N-2) & " направл. " & (N-1)
             s = s & x(1, i) & " " & x(1, i - 2) & " направл. " & x(1, i - 1) & vbCrLf
         End If
     End If
Next i
MsgBox s, 64
End Sub
[/vba]

Автор - nilem
Дата добавления - 13.08.2015 в 12:38
Мурад Дата: Четверг, 13.08.2015, 14:04 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Вот заразы! Не устраивает исполнителей один файл. Дело в том, что один человек заносит информацию по событиям заявок, а другой человек - по событиям проектов договоров и договоров. В одном файле, видите ли, им работать неудобно... :'( Буду думать, как разделить этот файл на 2 файла с отображением полной истории событий по каждому файлу
 
Ответить
СообщениеВот заразы! Не устраивает исполнителей один файл. Дело в том, что один человек заносит информацию по событиям заявок, а другой человек - по событиям проектов договоров и договоров. В одном файле, видите ли, им работать неудобно... :'( Буду думать, как разделить этот файл на 2 файла с отображением полной истории событий по каждому файлу

Автор - Мурад
Дата добавления - 13.08.2015 в 14:04
Мурад Дата: Четверг, 13.08.2015, 14:08 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
nilem, твой код безупречен! Работает по принципу "1-0", "1-1". А вот по "0-1" не работает по моей вине. Сам не уточнил вначале, извиняюсь. Но это дело техники, наверное :)
Написал пост про 2х исполнителей. Если не получится ничего самому, создам тему.
 
Ответить
Сообщениеnilem, твой код безупречен! Работает по принципу "1-0", "1-1". А вот по "0-1" не работает по моей вине. Сам не уточнил вначале, извиняюсь. Но это дело техники, наверное :)
Написал пост про 2х исполнителей. Если не получится ничего самому, создам тему.

Автор - Мурад
Дата добавления - 13.08.2015 в 14:08
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Журнал событий (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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