385 lines
14 KiB
QBasic
385 lines
14 KiB
QBasic
Sub ML_AddListA4()
|
||
'for debug
|
||
'MsgBox "Запуск функции вставки листа А4"
|
||
|
||
'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
|
||
|
||
With Selection.PageSetup
|
||
.PaperSize = wdPaperA4
|
||
.Orientation = wdOrientLandscape
|
||
.TopMargin = CentimetersToPoints(2)
|
||
.BottomMargin = CentimetersToPoints(2)
|
||
.LeftMargin = CentimetersToPoints(3)
|
||
.RightMargin = CentimetersToPoints(1.5)
|
||
End With
|
||
|
||
'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
|
||
|
||
|
||
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
|
||
|
||
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
|
||
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
|