Вывести панель состояния Excel?

Я разрабатываю приложение для excel, выполнение которого занимает много времени, поэтому было бы неплохо, если бы всплывала шкала выполнения, которая показывала прогресс. Я смотрел на свойство Statusbar в Excel и, кажется, покрывает то, что мне нужно, за исключением того, что это не очень очевидно, то есть это крошечное маленькое уведомление в левом нижнем углу, которое, если бы я не ожидал, я бы не Я не заметил, что меня совершенно не устраивает.

Есть ли способ, чтобы строка состояния отображалась в новом окне стиля MsgBox , аналогичном тому, что вы могли бы ожидать при передаче файлов в Windows? Объект типа индикатора выполнения, фактически отображаемый на листе Excel, как в этом примере, не идеален, и я ищу лучшее решение.

Я использую Office 2010 в Windows.


Я только что создал для вас 4 индикатора выполнения. Выбирайте 🙂

Панель прогресса основана на коде Stephen Bullen's PastePicture . Остальную часть индикатора выполнения легко создать. В конце я приложил образец файла, который вы можете скачать и протестировать.

НЕСКОЛЬКО СНАПШОТОВ

КОД

В пользовательской форме

  Option ExplicitPrivate Sub UserForm_Activate () Dim i As Long, j As Long, k As Long, l  As Long, m As Long j = 0: k = 0: l = 500: m = 100 For i = 1 To 11 '~~> Pie Progressbar Листы функций PastePicture Стивена Буллена ("Sheet2"). Фигуры (i) .CopyPicture  Установите Me.Image1.Picture = PastePicture (xlPicture) Me.Caption = "Progress -" & j & "%" '~~> 2nd Progressbar Label1.Width = k Label1.BackColor = & HFF8080 TextBox1.Text = j & "%"  '~~> 3-й индикатор выполнения Выбрать случай j Случай 10: CommandButton1.Visible = True Случай 20: CommandButton2.Visible = True Случай 30: CommandButton3.Visible = True Случай 40: CommandButton4.Visible = True Случай 50: CommandButton5.Visi  ble = True Случай 60: CommandButton6.Visible = True Случай 70: CommandButton7.Visible = True Случай 80: CommandButton8.Visible = True Случай 90: CommandButton9.Visible = True Случай 100: CommandButton10.Visible = True End Select '~~> 4-й  Индикатор выполнения (обратный) Label2.Width = l Label2.BackColor = & HC000 & TextBox2. Text = m & "% Left" Подождите 5 j = j + 10: k = k + 50 l = l - 50: m = m - 10 Далее i Выгрузите MeEnd SubPrivate Sub Wait (ByVal nSec As Long) nSec = nSec + Timer  Пока nSec> Timer DoEvents WendEnd Sub  

В модуле (функция PastePicture Стивена Буллена)

  Option Explicit '********************************************  ***************************** '*' * ИМЯ МОДУЛЯ: Вставить изображение '* АВТОР И ДАТА: СТИФЕН БУЛЛЕН, Автоматизация делопроизводства  Ltd '* 15 ноября 1998 г.' * '* КОНТАКТ: Stephen@oaltd.co.uk'* ВЕБ-САЙТ: http://www.oaltd.co.uk'*'* ОПИСАНИЕ: Создает стандартный объект Picture из того, что находится  буфер обмена. '* Этот объект затем может быть назначен (например) и элементу управления изображением' * в пользовательской форме.  Функция PastePicture принимает необязательный аргумент '* тип изображения - xlBitmap или xlPicture.' * '* Код требует ссылки на библиотеку типов "OLE Automation"' * '* Код в этом модуле получен из числа  of sources '* обнаружен в MSDN.' * '* Чтобы использовать его, просто скопируйте этот модуль в свой проект, затем вы можете использовать:' * Set Image1.Picture = PastePicture (xlPicture) '*, чтобы вставить изображение того, что находится на  буфер обмена в стандартный элемент управления изображением. '*' * PROCEDURES: '* PastePicture Точка входа для подпрограммы' * CreatePicture Частная функция для преобразования дескриптора точечного рисунка или метафайла в ссылку OLE '* fnOLEError Получить текст ошибки для ошибки OLE  код'************************************************  ************************** Option Compare Text '' 'Типы, определяемые пользователем для вызовов API' Объявите UDT для хранения GUID для  IPicture OLE Интерфейс Частный тип GUID Data1 As Long Data2 As Integer Data3 As Integer Data4 (0–7) As ByteEnd Type'Объявить UDT для хранения растрового изображения в  FormationPrivate Type uPicDesc Size As Long Type As Long hPic As Long hPal As LongEnd Type '' 'Объявления функций Windows API' Содержит ли буфер обмена растровое изображение/метафайл? Закрытая функция объявления IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long '  Откройте буфер обмена для чтения Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long 'Получить указатель на растровое изображение/метафайлPrivate Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long'Close the clipboardPrivate Declare Function  CloseClipboard Lib "user32" () As Long 'Преобразование дескриптора в интерфейс OLE IPicture. Функция частного объявления OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long'  Создайте собственную копию метафайла, чтобы он не стирался при последующих обновлениях буфера обмена.. Объявить функцию CopyEnhMetaFile Lib «gdi32» Псевдоним «CopyEnhMetaFileA» (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long Создайте нашу собственную копию растрового изображения, чтобы оно не стиралось при последующих обновлениях буфера обмена. Объявить функцию CopyImage Lib  "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long 'Типы форматов API, которые нас интересуют Const CF_BITMAP = 2Const CF_PALETTE = 9Const CF_ENHMETAFILE = 14Const  IMAGE_BITMAP = 0Const LR_COPYRETURNORG = & H4 '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '  '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ''  '' '' '' 'Подпрограмма: PastePicture' '' '' 'Цель: получить объект Picture, показывающий все, что находится в буфере обмена.' '' '' 'Аргументы: lXlPicType - Тип создаваемого изображения.  Может быть одним из: '' 'xlPicture для создания метафайла (по умолчанию)' '' xlBitmap для создания растрового изображения '' '' '' Date Developer Action '' '--------------  --------------------------------------------------  ---------- '' '30 октября 98 г. Создан Стивен Буллен' '' 15 ноября 98 г. Стивен Буллен Обновлен для создания наших собственных копий изображений из буфера обмена '' 'Функция PastePicture (необязательно lXlPicType As Long = xlPicture)  Как IPicture 'Некоторые указатели Dim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long' Преобразование типа изображения, запрошенного из константы xl в константу API lPicType = IIf (lXlPicType = xlBitmap,  CF_BITMAP, CF_ENHMETAFILE) 'Проверяем, содержит ли буфер обмена требуемую форму.  = GetClipboardData (lPicType) 'Создайте нашу собственную копию изображения в буфере обмена в соответствующем формате. Если lPicType = CF_BITMAP Then hCopy = CopyImage (hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) Иначе hCopy = CopyEnhMetaFile (hPtr, vbNullString) End If 'Освободить дескриптор буфера обмена для других программ, h = Close  преобразовать его в объект Picture и вернуть его. Если hPtr  0 Then Set PastePicture = CreatePicture (hCopy, 0, lPicType) End IfEnd IfEnd Function '' '' '' '' '' '' '' '' '' ''  '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ''  '' '' '' '' '' '' '' '' '' '' '' '' '' '' Подпрограмма: CreatePicture '' '' '' Цель: преобразование дескриптора изображения (и палитры)  в объект Picture. '' '' '' Требуется ссылка на библиотеку типов "OLE Automation" '' '' '' Аргументы: Нет '' '' '' Действие разработчика даты '' '-------  --------------------------------------------------  ----------------- '' '30 октября 98 г. Стивен Буллен создал' '' Частная функция CreatePicture (ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture 'IPicture  требуется ссылка на "OLE Automation" Dim r As Long, uPicInfo As uPicDes  c, IID_IDispatch как GUID, IPic как IPicture'OLE Типы изображенийConst PICTYPE_BITMAP = 1Const PICTYPE_ENHMETAFILE = 4 'Создайте GUID интерфейса (для интерфейса IPicture) с помощью IID_IDispatch .Data1 = & H7BF80980 .Data4Data2 = & HBF80980.  & H8B .Data4 (1) = & HBB .Data4 (2) = & H0 .Data4 (3) = & HAA .Data4 (4) = & H0 .Data4 (5) = & H30 .Data4 (6) = & HC .Data4 (7) = & HABEnd  С помощью 'Заполнить uPicInfo необходимыми частями. С помощью uPicInfo .Size = Len (uPicInfo)' Длина структуры.  .Type = IIf (lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE) 'Тип изображения .hPic = hPic' Дескриптор изображения.  .hPal = IIf (lPicType = CF_BITMAP, hPal, 0) 'Дескриптор палитры (если растровое изображение). Закончить с' Создать объект изображения. r = OleCreatePictureIndirect (uPicInfo, IID_IDispatch, True, IPic) 'Если произошла ошибка, показать  descriptionIf r  0 Then Debug.Print "Create Picture:" & fnOLEError (r) 'Возвращает новый объект Picture. Установить CreatePicture = IPicEnd Function '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ''  '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ''  '' '' '' Подпрограмма: fnOLEError '' '' '' Цель: получает текст сообщения для стандартных ошибок OLE '' '' '' Аргументы: Нет '' '' '' Действие разработчика даты '' '----  --------------------------------------------------  -------------------- '' '30 октября 1998 г. Создан Стивен Буллен' '' Частная функция fnOLEError (lErrNum As Long) как String'OLECreatePictureIndirect возвращаемые значенияConst E_ABORT = & H80004004Const E_ACCESSDENIED  = & H80070005Const E_FAIL = & H80004005Const E_HANDLE = & H80070006Const E_INVALIDARG = & H80070057Const E_NOINTERFACE = & H80004002Const E_NOTIMPL = & H80004001Const E_OUTOFMEMORY = & H8007000EConst E_POINTER = & H80004003Const E_UNEXPECTED = & H8000FFFFConst S_OK = & H0Select Case lErrNumCase E_ABORT fnOLEError = "Отменено" Дело E_ACCESSDENIED fnOLEError = "Отказано в доступе" Дело E_FAIL fnOLEError = "  Общий отказ "Случай E_HANDLE fnOLEError =" Неверный/отсутствующий дескриптор "Случай E_INVALIDA  RG fnOLEError = Случай «Недействительный аргумент» E_NOINTERFACE fnOLEError = Случай «Нет интерфейса» E_NOTIMPL fnOLEError = Случай «Не реализован» E_OUTOFMEMORY fnOLEError = Случай «Недостаточно памяти» E_POINTEROfnOLEError = "Случай Неисправный E_POINTEROfnOLEError =" Ошибка POINTEROfnOLEError = "Ошибка POINTEROfnOLEError =" Ошибка Неизвестный случай  fnOLEError = "Success!" Завершить функцию SelectEnd  

ОБРАЗЕЦ ФАЙЛА

https://www.dropbox. com/s/5k9f79yewqehdup/progressbar% 20example.xlsm? dl = 0


9

У Джона Уокенбаха есть еще один хороший пример: http://spreadsheetpage.com/index.php/site/tip/displaying_a_progress_indicator/

Трудно заставить его точно отразить процент завершения от общей выполняемой работы, но он показывает прогресс, который убеждает ваших пользователей, что Excel по-прежнему жив. Полосы прогресса редко бывают такими точными.

Поделиться
Улучшите это ответ
изменён 29 мая ’12 в 12:46
ответил 28 мая ’12 в 23:09
добавить комментарий |

У Джона Уокенбаха есть еще один хороший пример: http://spreadsheetpage.com/index.php/site/tip/displaying_a_progress_indicator/

Трудно сделать это точно отражает процент выполнения от общей работы, которая выполняется, но показывает прогресс, который убеждает ваших пользователей в том, что Excel по-прежнему жив. Индикаторы выполнения редко бывают такими точными.

Оцените статью
Botgadget.ru
Добавить комментарий