Добавлен макрос форматирования таблицы

2025-05-14 23:59:04 +03:00
parent 399e02bf3f
commit 935281479d
5 changed files with 192 additions and 54 deletions
--- a/Gostomizer.dotm
+++ b/Gostomizer.dotm
--- a/MacrosList.bas
+++ b/MacrosList.bas
@@ -1,54 +1,6 @@
-Attribute VB_Name = "MacrosList"
-
-Sub ML_AddListA4()
-    'for debug
-    'MsgBox "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20>4"
-    
-    MsgBox "<22><> Selection.PageSetup.Orientation = " & Selection.PageSetup.Orientation
-    
-     Selection.InsertBreak Type:=wdSectionBreakNextPage
-    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)
-        .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 "<22><><EFBFBD><EFBFBD><EFBFBD> Selection.PageSetup.Orientation = " & Selection.PageSetup.Orientation
-    
-    If Selection.PageSetup.Orientation = wdOrientPortrait Then
-        MsgBox "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
-        Selection.PageSetup.Orientation = wdOrientLandscape
-    Else
-        MsgBox "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
-        Selection.PageSetup.Orientation = wdOrientPortrait
-    End If
-    
-End Sub
-
 Sub ML_AddListA3()
    'for debug
-    MsgBox "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20>3"
+    'MsgBox "Запуск функции вставки листа А3"
    
    Dim ps As PageSetup
    
@@ -84,7 +36,165 @@ Sub ML_AddListA3()
    
    Selection.InsertBreak Type:=wdSectionBreakNextPage
    Selection.PageSetup = ps
+End Sub
+
+Sub ML_AddListA4()
+    'for debug
+    'MsgBox "Запуск функции вставки листа А4"
+    
+    MsgBox "до Selection.PageSetup.Orientation = " & Selection.PageSetup.Orientation
+    
+     Selection.InsertBreak Type:=wdSectionBreakNextPage
+    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)
+        .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
+
+Sub ML_TableFormatter()
+
+Dim CurrTbl As Table
+
+    If Selection.Tables.Count >= 1 Then
+        'MsgBox ("выбрана таблица")
+        
+        Set CurrTbl = Selection.Tables(1)
+        CurrTbl.Select
+        'MsgBox ("выбрана эта таблица")
+    
+        'Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
+        Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
+        Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
+        Selection.Font.Name = "Arial"
+        Selection.Font.Size = 12
+        
+        With Selection.Rows
+            .HeightRule = wdRowHeightAtLeast
+            .Height = CentimetersToPoints(0.7)
+            .AllowBreakAcrossPages = False
+        End With
+        
+        With Selection.Tables(1)
+            .TopPadding = CentimetersToPoints(0.05)
+            .BottomPadding = CentimetersToPoints(0.05)
+            .LeftPadding = CentimetersToPoints(0.05)
+            .RightPadding = CentimetersToPoints(0.05)
+            .Spacing = 0
+            .AllowPageBreaks = True
+            .AllowAutoFit = False
+            .PreferredWidthType = wdPreferredWidthPoints
+            .Rows.LeftIndent = CentimetersToPoints(0.1)
+            .PreferredWidth = CentimetersToPoints(17.3)
+            With .Borders(wdBorderLeft)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+            With .Borders(wdBorderRight)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+            With .Borders(wdBorderTop)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+            With .Borders(wdBorderVertical)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+            With .Borders(wdBorderHorizontal)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth050pt
+                .Color = wdColorAutomatic
+            End With
+            With .Borders(wdBorderBottom)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+        End With
+        
+        
+          
+        With Selection.Rows(1)
+            .Height = CentimetersToPoints(1.4)
+            .HeadingFormat = True
+            With .Borders(wdBorderLeft)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+            With .Borders(wdBorderRight)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+            With .Borders(wdBorderTop)
+                .LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+            With .Borders(wdBorderBottom)
+                .LineStyle = wdLineStyleDouble
+                '.LineStyle = wdLineStyleSingle
+                .LineWidth = wdLineWidth150pt
+                .Color = wdColorAutomatic
+            End With
+        End With
+        
+        CurrTbl.Rows(1).Select
+        'MsgBox ("выбрана первая строчка")
+        
+        Selection.Rows(1).Select
+        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
+        Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
+        'MsgBox ("первая строка отформатирована")
+        
+        'MsgBox ("Done!")
+        'MsgBox ("Готово!")
+        
+    Else
+        'MsgBox ("Table not select !")
+        MsgBox ("Не выбрана таблица !")
+    End If
    
    
 End Sub

+
--- a/README.md
+++ b/README.md
@@ -1,2 +1,27 @@
 # Gostomizer
+Расширение для Word. Создает дополнительную вкладку с набором полезных для меня функций

+## Как установить
+Разместить файл по следующему пути:
+C:\Users\[ИмяПользователя]\AppData\Roaming\Microsoft\Word\STARTUP
+
+
+## Текущий набор функций:
+1. Форматирование таблицы по ГОСТ
+2. Добавление нового раздела после курсора с горизонтальным листом А4
+3. Добавление нового раздела после курсора с горизонтальным листом А3
+
+
+## Планируемые функции
+1. Форматироание картинки
+2. Автоматическая установка расширения при открытии
+3. Вставка штампов целиком и частями
+4. Добавления ряда интересных функций из addin_wordtools
+5. Добавления ряда интересных функций из addin_macrotoolsword
+6. вставка вертикальных листов как опция, выбор по выпадающему списку из кнопки
+7. Добавление подготовленных стилей в документ, чтобы форматирование картинки или таблицы происходило корректно. Изменение текущих стилей документа. Или приведение стилей к определенному шаблону.
+
+## Планируемые доработки скриптов
+1. Форматирование таблицы - автоматическое определение формата листа и подгон ширины под формат листа.
+2. Вставка горизонтального листа. После вставки горинзонтального листа следующие страницы превращаются также в горизонтальные. Надо сделать так чтобы вставлялся только один горизонтальный лист как раздел, а следующие разделы шли без изменения.
+3. Добавить в форматирование таблицы вставку названия
--- a/RibbonCallbacks.bas
+++ b/RibbonCallbacks.bas
@@ -2,7 +2,10 @@ Option Explicit 'Потребовать явного объявления все

 'TableFormatter (элемент: button, атрибут: onAction), 2010+
 Private Sub TableFormatter(control As IRibbonControl)
-    MsgBox "Сработала процедура, заданная в onAction элемента " & control.ID
+    'MsgBox "Сработала процедура, заданная в onAction элемента " & control.ID
+    
+    Call ML_TableFormatter
+       
 End Sub

 'PicFormatter (элемент: button, атрибут: onAction), 2010+
@@ -24,7 +27,6 @@ Private Sub AddListA4(control As IRibbonControl)
    
    Call ML_AddListA3
    
-    
 End Sub

 'StampForm5 (элемент: button, атрибут: onAction), 2010+
@@ -61,3 +63,4 @@ End Sub
 Private Sub AddPageNumber(control As IRibbonControl)
    MsgBox "Сработала процедура, заданная в onAction элемента " & control.ID
 End Sub
+
--- a/Макросы.zip
+++ b/Макросы.zip