Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Дополнить макрос
 
Добрый день!
Нужна помощь в корректировки макроса.

У меня есть таблица эксель с данными, куда добавлен макрос на выгрузку данных с определенного листа.
Необходимо, чтобы по диапазону  таблицы Set rng = ws.Range("A18:M41") при выгрузке повторять заголовок ("A18:M18")на каждой странице, если таблица вся на 1 лист не будет умещаться.
Сделать это в ручную в самом файле ворд тоже не получается, так как таблица выгружаемая и кнопка "повторять заголовок на каждой странице" не активна

Sub ExportToWord()
   Dim wdApp As Object, wdDoc As Object
   Dim ws As Worksheet
   Dim rng As Range
   Dim wordTemplatePath As String
   Dim outputPath As String
   Dim fileName As String
   
   ' Путь к шаблону Word и выходному файлу
   wordTemplatePath = "C:\Users\m.stepanova\Desktop\тест\Шаблон_тест-спека.docx"
   outputPath = "C:\Users\m.stepanova\Desktop\тест\"
   fileName = "Результат_" & Format(Now(), "yyyy-mm-dd_hh-mm") & ".docx"
   
   ' Лист и диапазон данных в Excel
   Set ws = ThisWorkbook.Sheets("Спецификация")
   Set rng = ws.Range("A1:M17") ' Укажите нужный диапазон
   Set rng = ws.Range("A18:M41")
   Set rng = ws.Range("A1:M100")
   
   ' Создаем объект Word
   On Error Resume Next
   Set wdApp = GetObject(, "Word.Application")
   If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
   On Error GoTo 0
   
   ' Открываем шаблон
   Set wdDoc = wdApp.Documents.Open(wordTemplatePath)
   wdApp.Visible = True ' Показать Word (для отладки)
   
   ' Устанавливаем альбомную ориентацию для всего документа
   With wdDoc.PageSetup
       .Orientation = 1 ' 1 = wdOrientLandscape (альбомная)
       .TopMargin = wdApp.CentimetersToPoints(1.5)
       .BottomMargin = wdApp.CentimetersToPoints(1.5)
       .LeftMargin = wdApp.CentimetersToPoints(1.5)
       .RightMargin = wdApp.CentimetersToPoints(1.5)
   End With
   
   ' Копируем таблицу из Excel
   rng.Copy
   
   ' Вставляем в Word
   With wdDoc
       ' Если используете закладку:
       If .Bookmarks.Exists("TablePlaceholder") Then
           .Bookmarks("TablePlaceholder").Select
           wdApp.Selection.PasteExcelTable False, False, False
       Else
           ' Иначе просто в конец документа
           .Content.InsertAfter vbCrLf
           .Content.Paste
       End If
       
       ' Настройка таблицы (последней в документе)
       Dim wdTable As Object
       Set wdTable = .Tables(.Tables.Count)
       
       With wdTable
           ' Автоподбор по ширине страницы
           .AutoFitBehavior 1 ' 1 = wdAutoFitWindow
           ' Включение переноса строк
           .AllowAutoFit = True
           ' Настройка шрифта (опционально)
           .Range.Font.Name = "Calibri"
           .Range.Font.Size = 9
       End With
       
       ' Сохраняем результат с уникальным именем
       .SaveAs outputPath & fileName
   End With
   
   ' Очистка объектов
   Set wdTable = Nothing
   Set wdDoc = Nothing
   Set wdApp = Nothing
   
   MsgBox "Данные успешно экспортированы в Word!" & vbCrLf & _
          "Файл сохранен как: " & fileName, vbInformation
End Sub
Подключение запроса Power Query к папке
 
Всем привет!
Подскажите, как подключить готовый запрос Power Query к папке.
На отдельном листе есть таблица, где прописывается абсолютный пусть к папке и необходимо сделать так, чтобы все файлы с папки подгружались в запрос.
То есть в случае смены пути на папку данные подгружались с той папки, которая будет указана в этой таблице.  
Страницы: 1
Наверх