Страницы: 1
RSS
Подсчёт количества использований макросов надстройки
 
Cоздал по работе надстройку для Excel, в надстройку входят 12 модулей,  каждый из которых выполняет свою задачу и посажен на кнопку. Надстройку  я делал в программе RibbonXMLEditor. Лежит она сетевом диске и  используется 15-ю пользователями. Вопрос в том, можно ли реализовать  подсчёт количества использований всех макросов с выводом этой суммы на  панель Надстройки, или в какое другое меню. То есть в итоге необходимо просуммировать все использования всеми пользователями всех модулей и вывести это одним числом! Если можно такое реализовать, то куда копать?
 
Вариант: создать глобальную переменную-счётчик, приращение которой выполнять в каждой процедуре.  
 
Цитата
Юрий М написал:
создать глобальную переменную-счётчик,
Вы не могли бы на просто примере показать, как это делается?
 
Код
Public MyCounter As Long 'Переменная-счётчик

Sub Macro1()
    MyCounter = MyCounter + 1
    'Здесь код программы
End Sub

Sub Macro2()
    MyCounter = MyCounter + 1
    'Здесь код программы
End Sub

Sub Macro3()
    MyCounter = MyCounter + 1
    'Здесь код программы
End Sub


Результат можно хранить где-нибудь в укромном месте, чтобы при загрузке надстройки считать его.
 
Извините,а что значит хранить в укромном месте? Результат будет содержаться в объявленной переменной, её нужно куда то переместить? А насчёт вывода информации на панель, пока только одна идея: создать ещё один модуль,который будет выводит сообщение о состоянии переменной счетчика MsgBox MyCounter, и посадить этот модуль на кнопку Надстройки, но хотелось бы чтобы информация в режиме автомата обновлялась на панели Надстройки, хотя  элемента способного вывести такую информацию в разметке XML я не встречал ещё. Может вы знаете?
 
Цитата
abricos29 написал:
Результат будет содержаться в объявленной переменной, её нужно куда то переместить?
Хранить, например, в ячейке. А выводить в MsgBox - плохая идея: придётся каждый раз закрывать его. Да и отдельный модуль не нужен.
Может быть что-нибудь типа Label?
 
Под Label - вы имеете ввиду компонент XML-разметки? Сейчас порылся в xml-редакторе, создал отдельную группу и добавил в неё элемент Label, по смыслу показалось что более всего в данном случае подходит команда onChange(изменение значения компонента), но данная функция не определена для элемента Label:(
 
А значение переменной (или ячейки) разве нельзя присвоить Labei? Label1 = MyCounter
 
Нет, насколько я понимаю у данного элемента только информационные функции присутствуют, id-имя для программы и label-имя которое мы видим на панели Надстройки.
 
Как то так получается!
Изменено: abricos29 - 22.04.2017 07:54:53 (неправильная ссылка на картинку)
 
Мне не приходилось работать с XML, но для чего тогда Label, если на ней ничего нельзя отобразить? Может у Label есть свойство Caption? Я неверно написал в предыдущем сообщение: следует читать Label1.Caption = MyCounter
 
Если вместо "Счётчик" подставить переменную - не работает?
 
Лучше использовать отдельный текстовый файл, в который записывать накопленные значения - тогда история использований будет храниться и после закрытия надстройки.
Т.е. процесс такой:
при запуске у Вас есть глобальная переменная(как написал Юрий). И есть текстовый файл. Есть Label. При запуске файла считываете последние показания из текстового файла(при закрытии - обновляете последним значением MyCounter). Далее в XML-схеме надо прописать для Label вместо того, что у Вас, нечто вроде:
Код
<labelControl id="Счетчик" getLabel="getLabel_Cnt" />
Плюс в XML-схеме добавить такое:
Код
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="Init_RibVar_Custom" >
сейчас у Вас скорее всего просто:
Код
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" >
без onLoad.

И после этого в файл с кодом и этой схемой прописать такой код:
Код
Option Explicit
Public MyCounter As Long 'Переменная-счётчик
Public objRibCustom As IRibbonUI
Public cntr As IRibbonControl

Sub Init_RibVar_Custom(ribbon As IRibbonUI)
    Set objRibCustom = ribbon
    objRibCustom.Invalidate
End Sub
Sub getLabel_Cnt(control As IRibbonControl, ByRef label)
    If Not cntr Is Nothing Then label = "Счетчик: " & MyCounter
    Set cntr = control
    On Error Resume Next
    objRibCustom.InvalidateControl control.ID
    objRibCustom.Invalidate
End Sub

Sub Macro1()
    MyCounter = MyCounter + 1
    Call getLabel_Cnt(cntr, "")
    'Здесь код программы
End Sub
 
Sub Macro2()
    MyCounter = MyCounter + 1
    Call getLabel_Cnt(cntr, "")
    'Здесь код программы
End Sub
 
Sub Macro3()
    MyCounter = MyCounter + 1
    Call getLabel_Cnt(cntr, "")
    'Здесь код программы
End Sub
Теперь после запуска любого кода будет изменяться отображение Label на панели.

Пример подобного - во вложении. Только без считывания и записи данных в текстовый файл. Сами уж как-нибудь :)
Изменено: The_Prist - 22.04.2017 10:13:59
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist я просто в шоке, спасибо большое, если честно думал это не реализуемо! Теперь по факту, XML разметку по вашему примеру повторил, запись и чтение с текстового файла сделал как показано ниже. Есть несколько нюансов! Первый: когда открываю excel заново и подгружается Надстройка панелька не отображает значение счётчика, только после первого использования макроса на ней появляется значение. Второй нюанс: у меня по всему коду стоят проверки типа If..... Is Nothing Then.....End, и если макрос завершается сбросом такой проверки в End, то счетчик на панели сбрасывается в Пусто(что выглядит так же как и при вновь открытом файле), но в текстовый файл значение всё же приплюсовывает, и пока не перезапустить программу использовав хотя бы один макрос, счётчик отображать значение не будет.
Код
Open "D:\Counter.txt" For Input As #1 ' код в начале макроса
Input #1, MyCounter
Close #1
MyCounter = MyCounter + 1
Call getLabel_Cnt(cntr, "")

Open "D:\Counter.txt" For Output As #1 ' код в конце макроса
Print #1, MyCounter
Close #1
Изменено: abricos29 - 22.04.2017 22:31:13 (Неточности)
 
1. Смотря где записан код считывания. Надо прописывать в Init_RibVar_Custom.
2. Скорее всего просто обнуляется ссылка на переменную Ribbon панели. Во вложении файл с процедурой CheckRibbon, которая восстанавливает ссылку. Для этого используется функция API CopyMemory.
Должно работать на всех системах, но т.к. под рукой нет 32-битной - то проверить работоспособность в ней не могу.

P.S. И ссылку для текстового файла на свой диск замените.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Уважаемый The_Prist проверил ваш код, почему то один раз всё прошло успешно, а со второго ошибка на этой строчке кода:
Код
ThisWorkbook.Sheets("SETS").Range("A1") = ObjPtr(ribbon) ' Runtime error 9, Subscript out of range

Тут в ячейку А1 записывается значение переменной, а где эта переменная определена, я больше по коду не нашёл. Ещё я не пойму как ваше решение адаптировать под мои макросы?! В вашем коде жестко прописаны название Листа (SETS) и диапазон(A1), т.е. всегда в книге должен будет присутствовать некий Лист на котором в определённой ячейке будет хранится значение?

 
Цитата
abricos29 написал:
а где эта переменная определена, я больше по коду не нашёл
плохо искали. Она объявлена и передана аргументом в той же процедуре, где записывается в ячейку:
Sub Init_RibVar_Custom(ribbon As IRibbonUI)
   Set objRibCustom = ribbon
   ThisWorkbook.Sheets("SETS").Range("A1") = ObjPtr(ribbon)

Цитата
abricos29 написал:
В вашем коде жестко прописаны название Листа (SETS) и диапазон(A1)
Вы никаких примеров вообще не выложили, если Вы не заметили. Я Вам приложил рабочий готовый файл. Поэтому и имя листа и адрес ячейки мои. Что мешает подставить имя своего листа и диапазона? Да хоть в именованный диапазон пишите или в текстовый файл - дело личное. Главное хоть где-то хранить это значение, но не в переменной проекта.
Цитата
abricos29 написал:
со второго ошибка на этой строчке кода
В моем файле? Вы в нем пробовали запускать и работать? Или уже после переноса в свой файл? Потому что у меня работает и на второй и на третий раз.
Цитата
abricos29 написал:
как ваше решение адаптировать под мои макросы
Я показал принцип - не можете адаптировать, ну что я могу здесь сделать...
Судя по тому, что Вы даже не нашли переменную ribbon там, где она явно прослеживается - может Вам не заморачиваться настолько сильно?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 

Цитата
The_Prist написал:
плохо искали. Она объявлена и передана аргументом в той же процедуре, где записывается в ячейку:

Уважаемый The_Prist извините, что такие долгие паузы в нашем диалоге! Я и не знал что так можно объявлять переменную(искал именно ObjPtr(ribbon) ), да я много чего не знаю, но вроде это не повод не задать вопрос, который мне действительно интересен и не принесёт мне ровным счётом никакой фин.выгоды в отличии от некоторых участников форума. Код который вы написали для меня высшие материи, честно ничего не понятно, хотя я вроде не полный нуль, не самый плинтус:).

Цитата
The_Prist написал:
Вы никаких примеров вообще не выложили, если Вы не заметили.

Я просто не осознал что нужно выложить пример, у меня всё разбито на модули(куча кода), думал можно это показать на примере допустим вывода MsgBox

Цитата
The_Prist написал:
В моем файле? Вы в нем пробовали запускать и работать?

Да именно, я скопировал ваш файл, заменил в нём путь к текстовому файлу с G: на D: и попробовал запустить, первый раз всё прошло успешно, потом та ошибка которую я указал, сейчас я пробую запустить этот же файл и пишет уже другую ошибку(чувствую себя блондинкой).
Меня смутило, что в первом вашем коде мы записывали/считывали значение  счетчика из текстового файла, а в последнем варианте, добавляется некое значение которое прописывается на листе книги из которой он запускается и у него есть конкретное имя SETS , это меня и смутило, задача моих макросов запускаться каждый раз в новых файлах, где не будет такого листа. А так как код для меня слишком сложен, то и понять что я должен изменить чтобы работало у меня я не смог.
Прилагаю свою Надстройку без вашего кода, чистую.

Страницы: 1
Наверх