Files
Gostomizer/MacrosList.bas

201 lines
7.0 KiB
QBasic
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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
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