Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Добавить текст в конце нижнего колонтитула в ворд файле
 
#1
23.08.2017 10:59:10
Уважаемые форумчане!

Необходимо из excel файла (VBA) в определенной папке во всех word файлах добавить текст в конце нижнего колонтитула.
Пожалуйста, подскажите что не так в коде? Выделяет строку Selection. ...
Во вложении excel файл c этим кодом и WordFile куда нужно вставить "Необходимый текст"
Код
Sub InsertTextInFooterDown()

    Dim sFolder As String, sFiles As String
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim pShape As InlineShape

    Application.DisplayAlerts = wdAlertsNone
    Set wdApp = CreateObject("Word.Application")

    sFolder = "C:\....\" 'задать свой путь к папке
    sFiles = Dir(sFolder & "*.docx") 'полный путь к word файлу
    
    Do While sFiles <> "" 'открваем все word файлы в папке sFolder
        Set wdDoc = wdApp.Documents.Open(sFolder & sFiles) 'открываем файл
        wdDoc.Sections(1).Footers(1).Range.Tables.Item(1).Cell(1, 1).Range.Select 'выделяем первую ячейку таблицы
        Selection.MoveDown Unit:=wdScreen, Count:=1 'идем в конец колонтитула
        'задаем необходимый формат
        Selection.Font.Name = "Tahoma"
        Selection.Font.Italic = wdToggle
        Selection.Font.Size = 7
        Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
        Selection.ParagraphFormat.SpaceBefore = 1
        Selection.ParagraphFormat.SpaceBeforeAuto = False
        Selection.ParagraphFormat.SpaceAfter = 3
        Selection.ParagraphFormat.SpaceAfterAuto = False
        Selection.TypeText Text:="Необходимый текст" 'вставляем необходимый текст
        wdDoc.Close 'закрываем word файл
        sFiles = Dir
    Loop
    
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Application.DisplayAlerts = wdAlertsAll

End Sub
 
 
 
#2
23.08.2017 11:24:36
ac1-caesar, вот здесь
Код
wdDoc.Sections(1).Footers(1).Range.Tables.Item(1).Cell(1, 1).Range.Select 'выделяем первую ячейку таблицы
Selection.MoveDown Unit:=wdScreen, Count:=1 'идем в конец колонтитула

Selection.MoveDown у Вас относится к Excel'ю, должно быть wdDoc.Selection.MoveDown и т.д
Изменено: tolstak - 23.08.2017 11:26:03
In GoTo we trust
 
 
 
#3
23.08.2017 11:28:56
Код не тестировал, но ещё, как минимум, нужно в начале кода задать константу приложения word, которую Excel не знает: Const wdScreen = 7
Посмотрел - в references указана ссылка на Word 2016,  её лучше убрать, так как при открытии в предыдущих версиях эта ссылка станет битой (MISSING)
Изменено: ZVI - 23.08.2017 11:32:09
 
 
 
#4
23.08.2017 11:33:40
tolstak, пробовал wdDoc.Selection.MoveDown - ошибка та же Run-time error 438: Object doesn't support this property or method
 
 
 
#5
23.08.2017 11:34:46
ZVI, не совсем понял смысла Const wdScreen = 7.
С этим согласен, но на данный момент не критично -
Цитата
Посмотрел - в references указана ссылка на Word 2016,  её лучше убрать, так как при открытии в предыдущих версиях эта ссылка станет битой (MISSING)
Изменено: ac1-caesar - 23.08.2017 11:39:52
 
 
 
#6
23.08.2017 11:56:45
Цитата
ac1-caesar написал: смысла Const wdScreen = 7
Если в XLSM не установлена или битая ссылка на Microsoft 16.0 Object Library,  то внутри Excel нет такой константы, т.к. она определена не в Excel, а в приложении Word. Чтобы не зависеть от ссылки на Word можно либо задать в коде Excel константу как предложено (по сути, продублировать Word-овскую), либо в коде сразу записать числовое значение константы: Unit:=7
Изменено: ZVI - 23.08.2017 12:19:54
 
 
 
#7
23.08.2017 12:08:13
ac1-caesar, попробуйте еще так:
Было
Код
wdDoc.Sections(1).Footers(1).Range.Tables.Item(1).Cell(1, 1).Range.Select 'выделяем первую ячейку таблицы
        Selection.MoveDown Unit:=wdScreen, Count:=1 'идем в конец колонтитула
        'задаем необходимый формат
        Selection.Font.Name = "Tahoma"
        Selection.Font.Italic = wdToggle
        Selection.Font.Size = 7
        Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
        Selection.ParagraphFormat.SpaceBefore = 1
        Selection.ParagraphFormat.SpaceBeforeAuto = False
        Selection.ParagraphFormat.SpaceAfter = 3
        Selection.ParagraphFormat.SpaceAfterAuto = False
        Selection.TypeText Text:="Необходимый текст" 'вставляем необходимый текст
        wdDoc.Close 'закрываем word файл

Стало
Код
With ActiveDocument.Sections(1).Footers(1).Range.Tables.Item(1).Cell(1, 1).Range 
            'Selection.MoveDown Unit:=wdScreen, Count:=1 'идем в конец колонтитула
            'задаем необходимый формат
            .Font.Name = "Tahoma"
            .Font.Italic = wdToggle
            .Font.Size = 7
            .ParagraphFormat.Alignment = wdAlignParagraphRight
            .ParagraphFormat.SpaceBefore = 1
            .ParagraphFormat.SpaceBeforeAuto = False
            .ParagraphFormat.SpaceAfter = 3
            .ParagraphFormat.SpaceAfterAuto = False
            .Text = "Необходимый текст" 'вставляем необходимый текст
        End With
In GoTo we trust
 
 
 
#8
23.08.2017 12:13:39
Удалите ссылку на Word и попробуйте такую версию кода:
Код
Sub InsertTextInFooterDown()

    Const wdScreen = 7
    
    Dim sFolder As String, sFiles As String
    Dim wdApp As Object 'New Word.Application
    Dim wdDoc As Object 'Word.Document
    Dim IsCreated As Boolean

    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err Then
      On Error GoTo 0
      Set wdApp = CreateObject("Word.Application")
      IsCreated = True
      wdApp.Visible = True
    End If

    sFolder = "C:\Temp\22\" 'задать свой путь к папке
    sFiles = Dir(sFolder & "*.docx") 'полный путь к word файлу
    
    Do While sFiles <> "" 'открваем все word файлы в папке sFolder
        Set wdDoc = wdApp.Documents.Open(sFolder & sFiles) 'открываем файл
        wdDoc.Sections(1).Footers(1).Range.Tables.Item(1).Cell(1, 1).Range.Select 'выделяем первую ячейку таблицы
        With wdApp.Selection
          .MoveDown Unit:=wdScreen, Count:=1 'идем в конец колонтитула
          'задаем необходимый формат
          .Font.Name = "Tahoma"
          .Font.Italic = wdToggle
          .Font.Size = 7
          .ParagraphFormat.Alignment = wdAlignParagraphRight
          .ParagraphFormat.SpaceBefore = 1
          .ParagraphFormat.SpaceBeforeAuto = False
          .ParagraphFormat.SpaceAfter = 3
          .ParagraphFormat.SpaceAfterAuto = False
          .TypeText Text:="Необходимый текст" 'вставляем необходимый текст
        End With
        wdDoc.Save  ' сохранить
        wdDoc.Close 'закрываем word файл
        sFiles = Dir
    Loop
    
    If IsCreated Then wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing

End Sub
Изменено: ZVI - 23.08.2017 12:17:24
 
 
 
#9
23.08.2017 12:20:10
ZVI, да, сейчас работает - спасибо!
Понял, что Selection было лишним, вернее не доработанным.  
Изменено: ac1-caesar - 23.08.2017 15:16:40
 
 
 
#10
23.08.2017 12:21:51
tolstak,
Цитата
Стало
в этом случае однако в ячейку таблицы текст вставляется. В любом случае спасибо за уделенное время и внимание!
Изменено: ac1-caesar - 23.08.2017 12:22:19
 
 
 
Страницы: 1
Наверх