diff --git a/Gostomizer.dotm b/Gostomizer.dotm index 44716b4..6c02d12 100644 Binary files a/Gostomizer.dotm and b/Gostomizer.dotm differ diff --git a/MacrosList.bas b/MacrosList.bas index ca501aa..10a16f8 100644 --- a/MacrosList.bas +++ b/MacrosList.bas @@ -1,86 +1,119 @@ -Sub ML_AddListA3() - 'for debug - 'MsgBox "Запуск функции вставки листа А3" - - Dim ps As PageSetup - - Set ps = Selection.PageSetup - - Selection.InsertBreak Type:=wdSectionBreakNextPage - With Selection.PageSetup - .LineNumbering.Active = False - .Orientation = wdOrientLandscape - .TopMargin = CentimetersToPoints(1.5) - .BottomMargin = CentimetersToPoints(3) - .LeftMargin = CentimetersToPoints(2) - .RightMargin = CentimetersToPoints(2) - .Gutter = CentimetersToPoints(0) - .HeaderDistance = CentimetersToPoints(1.25) - .FooterDistance = CentimetersToPoints(1.25) - .PageWidth = CentimetersToPoints(29.7) - .PageHeight = CentimetersToPoints(21) - .FirstPageTray = wdPrinterDefaultBin - .OtherPagesTray = wdPrinterDefaultBin - .SectionStart = wdSectionNewPage - .OddAndEvenPagesHeaderFooter = False - .DifferentFirstPageHeaderFooter = False - .VerticalAlignment = wdAlignVerticalTop - .SuppressEndnotes = False - .MirrorMargins = False - .TwoPagesOnOne = False - .BookFoldPrinting = False - .BookFoldRevPrinting = False - .BookFoldPrintingSheets = 1 - .GutterPos = wdGutterPosLeft - End With - - Selection.InsertBreak Type:=wdSectionBreakNextPage - Selection.PageSetup = ps -End Sub - Sub ML_AddListA4() 'for debug 'MsgBox "Запуск функции вставки листа А4" - MsgBox "до Selection.PageSetup.Orientation = " & Selection.PageSetup.Orientation + 'Dim ps As PageSetup + + 'Set ps = Selection.PageSetup + + 'Loas inserting as new chapter/breaks + Selection.InsertBreak Type:=wdSectionBreakNextPage + Selection.InsertBreak Type:=wdSectionBreakNextPage + Selection.MoveLeft Unit:=wdCharacter, Count:=1 + + 'wdPaperSize - https://learn.microsoft.com/en-us/office/vba/api/word.wdpapersize + 'wdPaperA3 = 6 + 'wdPaperA4 = 7 - Selection.InsertBreak Type:=wdSectionBreakNextPage With Selection.PageSetup - .LineNumbering.Active = False - .Orientation = wdOrientPortrait + .PaperSize = wdPaperA4 + .Orientation = wdOrientLandscape .TopMargin = CentimetersToPoints(2) .BottomMargin = CentimetersToPoints(2) .LeftMargin = CentimetersToPoints(3) .RightMargin = CentimetersToPoints(1.5) - .Gutter = CentimetersToPoints(0) - .HeaderDistance = CentimetersToPoints(1.25) - .FooterDistance = CentimetersToPoints(1.25) - .PageWidth = CentimetersToPoints(29.7) - .PageHeight = CentimetersToPoints(42) - .FirstPageTray = wdPrinterDefaultBin - .OtherPagesTray = wdPrinterDefaultBin - .SectionStart = wdSectionNewPage - .OddAndEvenPagesHeaderFooter = False - .DifferentFirstPageHeaderFooter = False - .VerticalAlignment = wdAlignVerticalTop - .SuppressEndnotes = False - .MirrorMargins = False - .TwoPagesOnOne = False - .BookFoldPrinting = False - .BookFoldRevPrinting = False - .BookFoldPrintingSheets = 1 - .GutterPos = wdGutterPosLeft End With - MsgBox "после Selection.PageSetup.Orientation = " & Selection.PageSetup.Orientation + 'With Selection.PageSetup + ' .LineNumbering.Active = False + ' .Orientation = wdOrientLandscape + ' .TopMargin = CentimetersToPoints(1.5) + ' .BottomMargin = CentimetersToPoints(3) + ' .LeftMargin = CentimetersToPoints(2) + ' .RightMargin = CentimetersToPoints(2) + ' .Gutter = CentimetersToPoints(0) + ' .HeaderDistance = CentimetersToPoints(1.25) + ' .FooterDistance = CentimetersToPoints(1.25) + ' .PageWidth = CentimetersToPoints(29.7) + ' .PageHeight = CentimetersToPoints(21) + ' .FirstPageTray = wdPrinterDefaultBin + ' .OtherPagesTray = wdPrinterDefaultBin + ' .SectionStart = wdSectionNewPage + ' .OddAndEvenPagesHeaderFooter = False + ' .DifferentFirstPageHeaderFooter = False + ' .VerticalAlignment = wdAlignVerticalTop + ' .SuppressEndnotes = False + ' .MirrorMargins = False + ' .TwoPagesOnOne = False + ' .BookFoldPrinting = False + ' .BookFoldRevPrinting = False + ' .BookFoldPrintingSheets = 1 + ' .GutterPos = wdGutterPosLeft + 'End With - If Selection.PageSetup.Orientation = wdOrientPortrait Then - MsgBox "Портретная" - Selection.PageSetup.Orientation = wdOrientLandscape - Else - MsgBox "Альбомная" - Selection.PageSetup.Orientation = wdOrientPortrait - End If + +End Sub + +Sub ML_AddListA3() + 'for debug + 'MsgBox "Запуск функции вставки листа А3" + 'MsgBox "до Selection.PageSetup.Orientation = " & Selection.PageSetup.Orientation + + 'Loas inserting as new chapter/breaks + Selection.InsertBreak Type:=wdSectionBreakNextPage + Selection.InsertBreak Type:=wdSectionBreakNextPage + Selection.MoveLeft Unit:=wdCharacter, Count:=1 + + 'wdPaperSize - https://learn.microsoft.com/en-us/office/vba/api/word.wdpapersize + 'wdPaperA3 = 6 + 'wdPaperA4 = 7 + + With Selection.PageSetup + .PaperSize = wdPaperA3 + .Orientation = wdOrientLandscape + .TopMargin = CentimetersToPoints(2) + .BottomMargin = CentimetersToPoints(2) + .LeftMargin = CentimetersToPoints(3) + .RightMargin = CentimetersToPoints(1.5) + End With + + 'With Selection.PageSetup + ' .LineNumbering.Active = False + ' .Orientation = wdOrientPortrait + ' .TopMargin = CentimetersToPoints(2) + ' .BottomMargin = CentimetersToPoints(2) + ' .LeftMargin = CentimetersToPoints(3) + ' .RightMargin = CentimetersToPoints(1.5) + ' .Gutter = CentimetersToPoints(0) + ' .HeaderDistance = CentimetersToPoints(1.25) + ' .FooterDistance = CentimetersToPoints(1.25) + ' '.PageWidth = CentimetersToPoints(29.7) + ' '.PageHeight = CentimetersToPoints(42) + ' .PaperSize = wdPaperA3 + ' .FirstPageTray = wdPrinterDefaultBin + ' .OtherPagesTray = wdPrinterDefaultBin + ' .SectionStart = wdSectionNewPage + ' .OddAndEvenPagesHeaderFooter = False + ' .DifferentFirstPageHeaderFooter = False + ' .VerticalAlignment = wdAlignVerticalTop + ' .SuppressEndnotes = False + ' .MirrorMargins = False + ' .TwoPagesOnOne = False + ' .BookFoldPrinting = False + ' .BookFoldRevPrinting = False + ' .BookFoldPrintingSheets = 1 + ' .GutterPos = wdGutterPosLeft + 'End With + + 'MsgBox "после Selection.PageSetup.Orientation = " & Selection.PageSetup.Orientation + + 'If Selection.PageSetup.Orientation = wdOrientPortrait Then + ' MsgBox "Портретная" + ' Selection.PageSetup.Orientation = wdOrientLandscape + 'Else + ' MsgBox "Альбомная" + ' Selection.PageSetup.Orientation = wdOrientPortrait + 'End If End Sub @@ -196,5 +229,156 @@ Dim CurrTbl As Table End Sub +Sub ML_PicFormatter() + + Dim PicWidth, PicHeight, PicWidthA4, PicHeightA4, PicWidthA3, PicHeightA3 As Single + + 'настройка размера картиное + 'для а4 + PicWidth = 15 + PicHeight = 15 + + 'для а4 альбомного + PicWidthA4 = 25 + PicHeightA4 = 15 + + 'для а3 альбомного + PicWidthA3 = 37 + PicHeightA3 = 24 + + 'определяем тип оъекта в выделении + 'MsgBox "pic in selection = " & Selection.ShapeRange.Count + 'MsgBox "pic in inline selection = " & Selection.InlineShapes.Count + + ' WdSelectionType = + ' https://learn.microsoft.com/en-us/office/vba/api/word.wdselectiontype + 'MsgBox "Selection.Type = " & Selection.Type + + 'определяем тип фигуры + ' WdInlineShapeType = + ' https://learn.microsoft.com/ru-ru/office/vba/api/word.wdinlineshapetype + 'MsgBox "WdInlineShapeType = " & Selection.InlineShapes(1).Type + + + 'проверка на выделение картинки + 'wdSelectionInlineShape = 7 Inline shape + 'MsgBox "выделено картинок = " & Selection.InlineShapes.Count + + If Selection.InlineShapes.Count > 0 Then + 'MsgBox "поехали форматировать" + + 'проверяем ориентацию листа + If Selection.PageSetup.Orientation = wdOrientLandscape Then + 'альбомная, может быть А4 и А3 + 'MsgBox "Orientation = Landscape" + + + If Selection.PageSetup.PaperSize = 7 Then + 'MsgBox ("A4") + PicWidth = PicWidthA4 + PicHeight = PicHeightA4 + End If + + If Selection.PageSetup.PaperSize = 6 Then + 'MsgBox ("A3") + PicWidth = PicWidthA3 + PicHeight = PicHeightA3 + End If + + 'проверяем ширину картинки + 'MsgBox "width = " & PointsToCentimeters(Selection.InlineShapes(1).Width) & " / " & PicWidth + If PointsToCentimeters(Selection.InlineShapes(1).Width) > PicWidth Then + 'устанавливаем ширину в точках + Selection.InlineShapes(1).Width = CentimetersToPoints(PicWidth) + End If + + 'проверяем высоту картинки + 'MsgBox "height = " & PointsToCentimeters(Selection.InlineShapes(1).Width) & " / " & PicHeight + If PointsToCentimeters(Selection.InlineShapes(1).Height) > PicHeight Then + 'устанавливаем высоту в точках + Selection.InlineShapes(1).Height = CentimetersToPoints(PicHeight) + End If + + Else 'orientation + 'портретная - только для А4, проверяем только ширину + 'MsgBox "Orientation = Portrait" + + 'проверяем ширину картинки + 'MsgBox "width = " & PointsToCentimeters(Selection.InlineShapes(1).Width) + If PointsToCentimeters(Selection.InlineShapes(1).Width) > PicWidth Then + 'устанавливаем ширину в точках + Selection.InlineShapes(1).Width = CentimetersToPoints(PicWidth) + End If + + End If 'orientation + + 'выравниваем по центру + 'Selection.InlineShapes(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter + With Selection.InlineShapes(1).Range.ParagraphFormat + .Alignment = wdAlignParagraphCenter + .SpaceBeforeAuto = False + .SpaceAfterAuto = False + .FirstLineIndent = CentimetersToPoints(0) + End With + + 'применение стиля и вставка названия + 'Selection.Style = ActiveDocument.Styles("???????") + 'add autonumber + set style + 'Selection.InsertCaption Label:="???????", TitleAutoText:="InsertCaption1", _ + ' Title:=" - ", Position:=wdCaptionPositionBelow, ExcludeLabel:=0 + 'Selection.Style = ActiveDocument.Styles("???????? ???????") + + Selection.InlineShapes(1).Select + + + 'Label = WdCaptionLabelID - https://learn.microsoft.com/ru-ru/office/vba/api/word.wdcaptionlabelid + 'при испоьзовании WdCaptionLabelID вставляется английское название + 'wdCaptionEquation = -3 формула + 'wdCaptionFigure = -1 рисунок + 'wdCaptionTable = -2 таблица + 'Position = WdCaptionPosition - https://learn.microsoft.com/ru-ru/office/vba/api/word.wdcaptionposition + 'wdCaptionPositionAbove = 0 до объекта + 'wdCaptionPositionBelow = 1 после объекта + Selection.InsertCaption Label:="Рисунок", Title:=" - " ', Position:=wdCaptionPositionBelow + + + + + + + + Else 'нет картинок + MsgBox "Не выделена картинка!" + End If 'проверка на картинки + + + 'устанавливаем ширину в точках + 'Selection.InlineShapes(1).Width = CentimetersToPoints(15) + + + +End Sub +Sub ML_TestMacros() + + MsgBox ("Хоба!") + + MsgBox "Papersize = " & Selection.PageSetup.PaperSize + 'wdPaperSize - https://learn.microsoft.com/en-us/office/vba/api/word.wdpapersize + 'wdPaperA3 = 6 + 'wdPaperA4 = 7 + + If Selection.PageSetup.PaperSize = 7 Then + MsgBox ("A4") + End If + + If Selection.PageSetup.PaperSize = 6 Then + MsgBox ("A3") + End If + + + + + +End Sub diff --git a/README.md b/README.md index b4acff2..39eca15 100644 --- a/README.md +++ b/README.md @@ -7,21 +7,24 @@ C:\Users\[ИмяПользователя]\AppData\Roaming\Microsoft\Word\STARTUP ## Текущий набор функций: -1. Форматирование таблицы по ГОСТ -2. Добавление нового раздела после курсора с горизонтальным листом А4 -3. Добавление нового раздела после курсора с горизонтальным листом А3 +1. Форматирование таблицы по ГОСТ; +2. Форматирование картинки со вставкой названия. Размер картинки уменьшается до определенного размера, который зависит от формата (а3/а4) и ориентации листа (портретный/альбомный); +2. Добавление нового раздела после курсора с горизонтальным листом А4; +3. Добавление нового раздела после курсора с горизонтальным листом А3; ## Планируемые функции -1. Форматироание картинки -2. Автоматическая установка расширения при открытии -3. Вставка штампов целиком и частями -4. Добавления ряда интересных функций из addin_wordtools -5. Добавления ряда интересных функций из addin_macrotoolsword -6. вставка вертикальных листов как опция, выбор по выпадающему списку из кнопки -7. Добавление подготовленных стилей в документ, чтобы форматирование картинки или таблицы происходило корректно. Изменение текущих стилей документа. Или приведение стилей к определенному шаблону. +1. Автоматическая установка расширения при открытии +2. Вставка штампов целиком и частями +3. Добавления ряда интересных функций из addin_wordtools +4. Добавления ряда интересных функций из addin_macrotoolsword +5. вставка вертикальных листов как опция, выбор по выпадающему списку из кнопки +6. Добавление подготовленных стилей в документ, чтобы форматирование картинки или таблицы происходило корректно. Изменение текущих стилей документа. Или приведение стилей к определенному шаблону. ## Планируемые доработки скриптов 1. Форматирование таблицы - автоматическое определение формата листа и подгон ширины под формат листа. 2. Вставка горизонтального листа. После вставки горинзонтального листа следующие страницы превращаются также в горизонтальные. Надо сделать так чтобы вставлялся только один горизонтальный лист как раздел, а следующие разделы шли без изменения. -3. Добавить в форматирование таблицы вставку названия \ No newline at end of file +3. Добавить в форматирование таблицы вставку названия + +## Выполненные доработки +1. Добавлена функция форматирования картинки со вставкой названия. Размер картинки уменьшается до определенного размера, который зависит от формата (а3/а4) и ориентации листа (портретный/альбомный); \ No newline at end of file diff --git a/RibbonCallbacks.bas b/RibbonCallbacks.bas index 1b17a39..2471d74 100644 --- a/RibbonCallbacks.bas +++ b/RibbonCallbacks.bas @@ -10,7 +10,10 @@ End Sub 'PicFormatter (элемент: button, атрибут: onAction), 2010+ Private Sub PicFormatter(control As IRibbonControl) - MsgBox "Сработала процедура, заданная в onAction элемента " & control.ID + 'MsgBox "Сработала процедура, заданная в onAction элемента " & control.ID + + Call ML_PicFormatter + End Sub 'AddListA4 (элемент: button, атрибут: onAction), 2010+ @@ -64,3 +67,8 @@ Private Sub AddPageNumber(control As IRibbonControl) MsgBox "Сработала процедура, заданная в onAction элемента " & control.ID End Sub +'TestMacros (элемент: button, атрибут: onAction), 2010+ +Private Sub TestMacros(control As IRibbonControl) + 'MsgBox "Сработала процедура, заданная в onAction элемента " & control.ID + Call ML_TestMacros +End Sub \ No newline at end of file