Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.03.2018, 18:08   #1
MBura
Новичок
Джуниор
 
Регистрация: 12.03.2018
Сообщений: 1
По умолчанию Выбор нескольких документов (VBA скрипт, который позволяет переносить данные из Word в Excel)

Здравствуйте.
У меня есть скрипт, который позволяет переносить данные из Word в Excel, но по одному. Не получается осуществить выбор нескольких файлов, не могли бы помочь?

Код:
Sub CopyOldWordDoc()
Dim a As Variant, MainBook As Workbook, CurrentSheet As String
 Set MainBook = ActiveWorkbook
 CurrentSheet = ActiveSheet.Name
              Dim FD As FileDialog
              Dim iFileName As String
              Dim Book As Workbook
              Dim CheckNameBook As String
       Set FD = Application.FileDialog(msoFileDialogFilePicker)
       With FD
             .Filters.Clear
             '.Filters.Add "Microsoft Word files", "*.doc"
             .Filters.Add "All files", "*.*"
             .AllowMultiSelect = False
             .InitialFileName = ThisWorkbook.Path
             .Title = "Открытие документа"
             .ButtonName = "Открыть"
            If .Show = False Then
               MsgBox "Вы не указали файл - источник!", 48, "Ошибка"
               Exit Sub
            Else
               iFileName = .SelectedItems(1)
            End If
         End With
         Set FD = Nothing

        ' Открытие документа Word и копирование содержимого в новый лист

    Dim WordApp As Object, CopyArea As Variant
     Set WordApp = CreateObject("Word.Application")
       WordApp.Application.Visible = False
       WordApp.Documents.Open Filename:=iFileName
       With WordApp.ActiveDocument
           Set CopyArea = .Range(0, .Characters.Count)
               CopyArea.Select
               WordApp.Selection.Copy
       End With
       
     'создаем новый лист для переноса
     Set wsDataSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
     Dim TempBook As Workbook
     Set TempBook = ActiveWorkbook
         'TempBook.Worksheets(1).Cells.NumberFormat = "@"
         'TempBook.Worksheets(1).Range("A1").Select
         ActiveSheet.Paste
         'Application.CutCopyMove = False
         WordApp.Quit
        
 MainBook.Activate
 Worksheets(CurrentSheet).Activate
 Range("A1").Activate
End Sub


________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(это кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

Последний раз редактировалось Serge_Bliznykov; 13.03.2018 в 18:40.
MBura вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как макросом из excel брать данные с word документов? RISagitov Microsoft Office Excel 11 13.06.2013 14:21
Скрипт, который позволяет добавлять объекты в DOM Chel JavaScript, Ajax 2 05.03.2012 08:51
Экспорт значений из нескольких документов Word в одну таблицу Excel для дальнейших расчетов. YJYNGK Microsoft Office Excel 0 30.10.2010 13:42
Как средствами VBA экспортировать данные из Excel в Word? Pavel_Ine Microsoft Office Excel 3 20.04.2009 14:14