Вставка картинок в документ из выбранной папки

Я разработал шаблон, упрощающий процедуру вставки в документ изображений из указанной папки. При загрузке шаблона появляется дополнительная группа на вкладке «Вставка»

Возможности:

1. Выбор папки, из которой нужно часто вставлять изображения.


2. Просмотр эскизов изображений в галерее.


3. Обрабатываются (пока) только изображения форматов: "png", "jpg", "jpeg", "bmp", "gif".


4. Всплывающая подсказка к каждому изображению содержит имя файла, размеры изображения и разрешение по горизонтали и по вертикали.


5. Вставка изображений в заданном режиме: в текст или с обтеканием.


6. Автоматическая вставка названия к изображению с нумерацией или без.


7. Автоматическая вставка имени файла в название к изображению.

В раскрытом виде галерея может выглядеть так:

Галерея имеет фиксированное количество столбцов (5), количество строк зависит от количества изображений в выбранной папке.
Скачать шаблон можно отсюда
С точки зрения работы с лентой, этот шаблон интересен несколькими моментами. Во-первых, в нём реализована загрузка на ленту не только изображений bmp, но и других форматов.
Это стало возможным благодаря использованию функций GDI+. За основу взяты примеры для книги RibbonX: Customizing the Office 2007 Ribbon, которые можно скачать отсюда
Дело в том, что для отображения на ленте Office понимает только один формат изображения IPictureDisp. Получить этот формат изображения из файла можно функцией LoadPicture. Но она может загружать только изображения bmp. В шаблоне используется похожая функция LoadImage, описанная в модуле GDIPlusAPI. Код модуля выглядит так:

Модуль GDIPlusAPI   Копировать код без номеров строк

1 Attribute VB_Name = "GDIPlusAPI"
2 Option Private Module
3 Option Explicit
4
5 Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
6 Public Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal filename As Long, bitmap As Long) As GpStatus
7 Public Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As GpStatus
8 Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
9 Public Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
10 Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
11 Public Declare Function GdipGetImageDimension Lib "gdiplus" (ByVal image As Long, Width As Single, Height As Single) As GpStatus
12 Public Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As GpStatus
13 Public Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As GpStatus
14 Public Declare Function GdipGetImageHorizontalResolution Lib "gdiplus" (ByVal image As Long, resolution As Single) As GpStatus
15 Public Declare Function GdipGetImageVerticalResolution Lib "gdiplus" (ByVal image As Long, resolution As Single) As GpStatus
16 Public Declare Function GdipGetImageThumbnail Lib "gdiplus" (ByVal image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, _
17 Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As GpStatus
18 Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As GpStatus
19
20 Public Enum GpStatus
21 OK = 0
22 GenericError = 1
23 InvalidParameter = 2
24 OutOfMemory = 3
25 ObjectBusy = 4
26 InsufficientBuffer = 5
27 NotImplemented = 6
28 Win32Error = 7
29 WrongState = 8
30 Aborted = 9
31 FileNotFound = 10
32 ValueOverflow = 11
33 AccessDenied = 12
34 UnknownImageFormat = 13
35 FontFamilyNotFound = 14
36 FontStyleNotFound = 15
37 NotTrueTypeFont = 16
38 UnsupportedGdiplusVersion = 17
39 GdiplusNotInitialized = 18
40 PropertyNotFound = 19
41 PropertyNotSupported = 20
42 End Enum
43
44 Public Type GUID
45 Data1 As Long
46 Data2 As Integer
47 Data3 As Integer
48 Data4(0 To 7) As Byte
49 End Type
50
51 Public Type PICTDESC
52 Size As Long
53 Type As Long
54 hPic As Long
55 hPal As Long
56 End Type
57
58 Public Type GdiplusStartupInput
59 GdiplusVersion As Long
60 DebugEventCallback As Long
61 SuppressBackgroundThread As Long
62 SuppressExternalCodecs As Long
63 End Type
64
65
66 Public Function LoadImage(ByVal strFName As String) As IPicture
67 Dim uGdiInput As GdiplusStartupInput
68 Dim hGdiPlus As Long
69 Dim hGdiImage As Long
70 Dim hBitmap As Long
71 Dim imgThumb As Long
72 Dim imgHeight As Single, imgWidth As Single
73 uGdiInput.GdiplusVersion = 1
74
75 'Запускаем GDI+
76 If GdiplusStartup(hGdiPlus, uGdiInput) = OK Then
77 'Создаём изображение в памяти
78 If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = OK Then
79 'Получаем размеры изображения
80 Call GdipGetImageDimension(hGdiImage, imgWidth, imgHeight)
81 'Делаем из изображения уменьшенное
82 Call GdipGetImageThumbnail(hGdiImage, ItemWidth, ItemWidth * imgHeight / imgWidth, imgThumb)
83 'Указатель на изображение
84 Call GdipCreateHBITMAPFromBitmap(imgThumb, hBitmap, 0)
85 'Конвертируем изображение в IPicture
86 Set LoadImage = ConvertToIPicture(hBitmap)
87 GdipDisposeImage hGdiImage
88 End If
89 GdiplusShutdown hGdiPlus
90 Else
91 MsgBox "Ошибка при загрузке GDI+!", vbCritical
92 End If
93
94 End Function
95
96 Public Function ConvertToIPicture(ByVal hPic As Long) As IPicture
97
98 Dim uPicInfo As PICTDESC
99 Dim IID_IDispatch As GUID
100 Dim IPic As IPicture
101
102 Const PICTYPE_BITMAP = 1
103
104 With IID_IDispatch
105 .Data1 = &H7BF80980
106 .Data2 = &HBF32
107 .Data3 = &H101A
108 .Data4(0) = &H8B
109 .Data4(1) = &HBB
110 .Data4(2) = &H0
111 .Data4(3) = &HAA
112 .Data4(4) = &H0
113 .Data4(5) = &H30
114 .Data4(6) = &HC
115 .Data4(7) = &HAB
116 End With
117
118 With uPicInfo
119 .Size = Len(uPicInfo)
120 .Type = PICTYPE_BITMAP
121 .hPic = hPic
122 .hPal = 0
123 End With
124
125 OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
126
127 Set ConvertToIPicture = IPic
128 End Function
129

Загрузка изображений происходит в модуле RibbonCallbacks в процедуре getItemImage, которая, в свою очередь, определена в XML-схеме для галереи.

Загрузка изображений для элементов галереи   Копировать код без номеров строк

68 'galleryImagesFromFolder (компонент: gallery, атрибут: getItemImage)
69 Sub getItemImage(control As IRibbonControl, index As Integer, ByRef image)
70 If ImagesCount = 0 Then Exit Sub
71 Set image = LoadImage(arImagePaths(index))
72 End Sub

В этой процедуре arImagePaths — массив с путями к файлам изображений, index — номер элемента в галерее.

Во-вторых, на примере данного шаблона можно понять как работает механизм изменения состояния одних элементов ленты в зависимости от состояния других. Начнём с XML-схемы трёх флажков, расположенных в правой части группы, которые определяют правила вставки названия к вставляемому изображению.

XML-код флажков   Копировать код без номеров строк

51 <!-- Разделитель группы -->
52 <separator id="sep1" />
53 <checkBox id="chbInsertImageWithCaption"
54 label="Вставлять название"
55 supertip="Установите этот флажок, чтобы автоматически вставлять подпись к вставляемому рисунку."
56 onAction="chb_onAction" />
57 <checkBox id="chbUsePathInCaption"
58 label="Имя файла в названии"
59 supertip="Установите этот флажок, чтобы подпись к вставляемому рисунку содержала имя файла рисунка."
60 getEnabled="getEnabled"
61 onAction="chb_onAction" />
62 <checkBox id="chbNumberImage"
63 label="Нумеровать изображение"
64 supertip="Установите этот флажок, чтобы автоматически нумеровать вставляемое изображение."
65 getPressed="chb_getPressed"
66 getEnabled="getEnabled"
67 onAction="chb_onAction" />

У всех трёх флажков определён один общий динамический атрибут onAction, определяющий процедуру, которая выполняется при клике на соответствующем флажке. Двум последним флажкам задан атрибут getEnabled, определяющий процедуру, изменяющую активность этих флажков. Активность этих флажков меняется в зависимости от состояния первого флажка.
И, наконец, у третьего флажка задан атрибут getPressed, определяющий процедуру, изменяющую состояние флажка.
Теперь посмотрим, как это реализовано в VBA:

Процедура getEnabled   Копировать код без номеров строк

29 'galleryImagesFromFolder (компонент: gallery, атрибут: getEnabled)
30 'chbUsePathInCaption (компонент: checkBox, атрибут: getEnabled)
31 'chbUsePathInCaption (компонент: checkBox, атрибут: onAction)
32 'chbNumberImage (компонент: checkBox, атрибут: getEnabled)
33 Sub getEnabled(control As IRibbonControl, ByRef enabled)
34 Select Case control.ID
35 Case "chbUsePathInCaption"
36 enabled = chbInsertImageWithCaptionChecked
37 Case "chbNumberImage"
38 enabled = chbInsertImageWithCaptionChecked
39 Case Else
40 enabled = CBool(ImagesCount)
41 End Select
42 End Sub

Эта процедура при помощи селективного оператора определяет состояние какого элемента ленты нужно установить и присваивает ему значение соответствующей глобальной переменной.

Процедура chb_onAction   Копировать код без номеров строк

110 'chbInsertImageWithCaption (компонент: checkBox, атрибут: onAction)
111 'chbUsePathInCaption (компонент: checkBox, атрибут: onAction)
112 'chbNumberImage (компонент: checkBox, атрибут: getPressed)
113 Sub chb_onAction(control As IRibbonControl, pressed As Boolean)
114 Select Case control.ID
115 Case "chbUsePathInCaption"
116 chbUsePathInCaptionChecked = pressed
117 Case "chbNumberImage"
118 chbNumberImageChecked = pressed
119 Case "chbInsertImageWithCaption"
120 chbInsertImageWithCaptionChecked = pressed
121 If Not myRibbon Is Nothing Then
122 myRibbon.InvalidateControl "chbUsePathInCaption"
123 myRibbon.InvalidateControl "chbNumberImage"
124 Else
125 MsgBox "Связь с пользовательским интерфейсом customUI утеряна. Попробуйте переоткрыть документ, или переподключить шаблон", vbInformation + vbOKOnly
126 End If
127 End Select
128 End Sub

В этой процедуре, также с помощью селективного оператора, определяется флажок, на котором щёлкнул пользователь и состояние этого флажка, переданное параметром pressed, записывается в соответствующую глобальную переменную. Кроме того, если сработал первый флажок, то обновляется состояние остальных двух.

Процедура chb_getPressed   Копировать код без номеров строк

140 'chbNumberImage (компонент: checkBox, атрибут: getPressed)
141 Sub chb_getPressed(control As IRibbonControl, ByRef returnValue)
142 returnValue = chbNumberImageChecked
143 End Sub

Здесь всё просто: состояние флажка, на которое ссылается переменная returnedValue, устанавливается в соответствии со значением глобальной переменной. Здесь не используется селективный оператор, поскольку эта процедура вызывается только для одного флажка.

Замечания и пожелания приветствуются.