Sub addTable()
Dim wb As Excel.Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = «Выбрать файлы отчетов» ‘заголовок окна диалога
.Filters.Clear ‘очищаем установленные ранее типы файлов
.Filters.Add «Excel files», «*.xls*;*.xla*», 1 ‘устанавливаем возможность выбора только файлов Excel
.FilterIndex = 2 ‘устанавливаем тип файлов по умолчанию — Text files(Текстовые файлы)
.InitialFileName = ActiveDocument.Path ‘назначаем папку отображения и имя файла по умолчанию
.InitialView = msoFileDialogViewDetails ‘вид диалогового окна(доступно 9 вариантов)
If .Show = 0 Then Exit Sub ‘показывает диалог
‘цикл по коллекции выбранных в диалоге файлов
For lf = 1 To .SelectedItems.Count
FileName = .SelectedItems(lf) ‘считываем полный путь к файлу
Next
End With
If FileName = False Then Exit Sub
If Not IsEmpty(FileName) Then
Set wb = Workbooks.Open(FileName, False, False)
wb.Sheets(«Таблица в слайд»).Range(«rngTabInSlide2»).Copy ‘rngTabInSlide
ActiveDocument.Range.PasteExcelTable False, False, True
wb.Close
Set wb = Nothing
Else
Debug.Print wb.Path
Exit Sub
End If
End Sub
—-
Sub changeQuote()
‘Замена прямых кавычек на парные кавычки (елочки)
Dim blnQuotes As Boolean
‘запомнить пользовательскую установку
blnQuotes = Options.AutoFormatAsYouTypeReplaceQuotes
Options.AutoFormatAsYouTypeReplaceQuotes = False
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = «»»(*)»»»
.Replacement.Text = ««\1»»
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = «»» & «(*)»»»
.Replacement.Text = ««\1»»
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
‘восстановить пользовательскую установку
Options.AutoFormatAsYouTypeReplaceQuotes = blnQuotes
End Sub
Sub LineSpaceSingle()
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
End With
Selection.Font.Name = «Times New Roman»
Selection.Font.Size = 10
End Sub
Sub Макрос()
Dim par As Paragraph
For Each par In ActiveDocument.Paragraphs
‘ Исключение таблиц из перебора.
If par.Range.Information(wdWithInTable) = True Then
‘ If par.FirstLineIndent = 35.45 Then
par.FirstLineIndent = CentimetersToPoints(1.29)
‘ End If
End If
Next par
End Sub