Имеется данный макрос для загрузки таблиц из 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, код следует оформлять соответствующим тегом: ищите такую кнопку и исправьте своё сообщение. Спасибо! P.S. Тогда и нумеровать строки не придётся