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

2025-05-14 23:59:04 +03:00
parent 399e02bf3f
commit 935281479d
5 changed files with 192 additions and 54 deletions
--- 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
+
+