Страницы: 1
RSS
Макрос для загрузки таблиц из Word в Excel
 
Имеется данный макрос для загрузки таблиц из Word в exel c помощью макроса:
Код
 Sub Geometry()
 Dim arr As Variant
 With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With
 Set oWord = CreateObject("Word.Application")
 oWord.Visible = True
 Set oDoc = oWord.Documents.Open(ThisWorkbook.Path & "\" & "дизайн.rtf")
  
rr = 1
 
'On Error Resume Next
For aTbl = 1 To 4   'oDoc.tables.Count
ReDim arr(1 To oDoc.tables(aTbl).Rows.Count, 1 To oDoc.tables(aTbl).Columns.Count)
    For j = 1 To UBound(arr, 2)
        For i = 1 To UBound(arr, 1)
            arr(i, j) = Trim(Replace(oDoc.tables(aTbl).cell(i, j).Range.Text, Chr(7), ""))
    If IsNumeric(arr(i, j)) Then arr(i, j) = --arr(i, j)
        Next i
    Next j
ThisWorkbook.Sheets("Geo").Range("A" & rr).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
rr = rr + oDoc.tables(aTbl).Rows.Count + 2
arr = Empty
Next

oWord.Quit False
'..................
With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With
MsgBox "Геометрия загружена"
  End Sub


Что необходимо прописать чтобы файл открывался не из текущей папки по названию "Set oDoc = oWord.Documents.Open(ThisWorkbook.Path & "\" & "дизайн.rtf")", а была возможность выбрать местонахождение вручную.
Изменено: Dedmoroz86 - 01.11.2016 15:07:43
 
Dedmoroz86, код следует оформлять соответствующим тегом: ищите такую кнопку и исправьте своё сообщение.
Спасибо!
P.S. Тогда и нумеровать строки не придётся  :)
 
Dedmoroz86,
http://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/
Страницы: 1
Наверх