Помогите написать макрос в Excel - VB

Узнай цену своей работы

Формулировка задачи:

Привет всем! Помогите пожалуйста написать макрос!
Макрос должен брать таблицу из Word и вставлять ее в Excel, причем в документе Word несколько таблиц, нужную таблицу следует выбирать, например, по имени столбца.
Заранее спасибо!

Решение задачи: «Помогите написать макрос в Excel»

textual
Листинг программы
<font color="blue">Sub</font> Поиск()
<font color="blue">Dim</font> n, m, l, tb <font color="blue">As</font> <font color="blue">Long</font>
<font color="blue">Dim</font> Path <font color="blue">As</font> <font color="blue">String</font>

Path = GetFolderPath

<font color="blue">Set</font> wa = CreateObject(<font color="teal">"Word.Application"</font>)
<font color="blue">On</font> <font color="blue">Error</font> <font color="blue">GoTo</font> <font color="darkblue"><b>3</b></font>
<font color="blue">Set</font> oCurrDoc = wa.Documents.<font color="blue">Open</font>(Path)

wa.Visible = True



l = oCurrDoc.Tables.Count

<font color="blue">For</font> n = <font color="darkblue"><b>1</b></font> <font color="blue">To</font> l

<font color="blue">If</font> oCurrDoc.Tables(n).Range.Rows(<font color="darkblue"><b>1</b></font>).Cells(<font color="darkblue"><b>2</b></font>).Range.Text Like <font color="teal">"Наименование дисциплин*"</font> _
<font color="blue">And</font> oCurrDoc.Tables(n).Range.Rows(<font color="darkblue"><b>1</b></font>).Cells(<font color="darkblue"><b>1</b></font>).Range.Text Like <font color="teal">"Индекс*"</font> <font color="blue">Then</font>

tb = n

<font color="blue">Exit</font> <font color="blue">For</font>
<font color="blue">End</font> <font color="blue">If</font>

<font color="blue">Next</font>


n = oCurrDoc.Tables(tb).Range.Rows.Count
m = oCurrDoc.Tables(tb).Range.Columns.Count

<font color="blue">ReDim</font> Rng(<font color="darkblue"><b>1</b></font> <font color="blue">To</font> n, <font color="darkblue"><b>1</b></font> <font color="blue">To</font> m)

<font color="blue">For</font> n = <font color="darkblue"><b>1</b></font> <font color="blue">To</font> oCurrDoc.Tables(tb).Range.Rows.Count
<font color="blue">For</font> m = <font color="darkblue"><b>1</b></font> <font color="blue">To</font> oCurrDoc.Tables(tb).Range.Columns.Count



<font color="blue">On</font> <font color="blue">Error</font> <font color="blue">Resume</font> <font color="blue">Next</font>
<font color="blue">Dim</font> ssl <font color="blue">As</font> <font color="blue">String</font>
ssl = Replace(oCurrDoc.Tables(tb).Range.Rows(n).Cells(m).Range.Text, Chr(<font color="darkblue"><b>13</b></font>), <font color="teal">""</font>)

ssl = Replace(ssl, Chr(<font color="darkblue"><b>7</b></font>), <font color="teal">""</font>)

Rng(n, m) = ssl



<font color="blue">Next</font>


<font color="blue">Next</font>

Application.ScreenUpdating = False

ActiveSheet.Range(Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>), Cells(n - <font color="darkblue"><b>1</b></font>, m - <font color="darkblue"><b>1</b></font>)) = Rng

ActiveSheet.Range(<font color="teal">"a1"</font>).ColumnWidth = <font color="darkblue"><b>18</b></font>
ActiveSheet.Range(<font color="teal">"b1"</font>).ColumnWidth = <font color="darkblue"><b>100</b></font>
ActiveSheet.Range(<font color="teal">"c1"</font>).ColumnWidth = <font color="darkblue"><b>18</b></font>
ActiveSheet.Columns(<font color="teal">"A:C"</font>).WrapText = True



ActiveSheet.Range(Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>), Cells(n - <font color="darkblue"><b>1</b></font>, m - <font color="darkblue"><b>1</b></font>)).Borders(<font color="darkblue"><b>1</b></font>).LineStyle = <font color="darkblue"><b>1</b></font>
ActiveSheet.Range(Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>), Cells(n - <font color="darkblue"><b>1</b></font>, m - <font color="darkblue"><b>1</b></font>)).Borders(<font color="darkblue"><b>2</b></font>).LineStyle = <font color="darkblue"><b>1</b></font>
ActiveSheet.Range(Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>), Cells(n - <font color="darkblue"><b>1</b></font>, m - <font color="darkblue"><b>1</b></font>)).Borders(<font color="darkblue"><b>3</b></font>).LineStyle = <font color="darkblue"><b>1</b></font>
ActiveSheet.Range(Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>), Cells(n - <font color="darkblue"><b>1</b></font>, m - <font color="darkblue"><b>1</b></font>)).Borders(<font color="darkblue"><b>4</b></font>).LineStyle = <font color="darkblue"><b>1</b></font>


Application.ScreenUpdating = True

<font color="darkblue"><b>3</b></font>
wa.Quit
<font color="blue">End</font> <font color="blue">Sub</font>
<font color="blue">Function</font> GetFolderPath(Optional <font color="blue">ByVal</font> Title <font color="blue">As</font> <font color="blue">String</font> = <font color="teal">"Выберите файл"</font>, Optional <font color="blue">ByVal</font> InitialPath <font color="blue">As</font> <font color="blue">String</font>) <font color="blue">As</font> <font color="blue">String</font>
GetFolderPath = <font color="teal">""</font>: PS = Application.PathSeparator
<font color="blue">With</font> Application.FileDialog(msoFileDialogOpen)
.ButtonName = <font color="teal">"Выбрать"</font>: .Title = Title: .InitialFileName = InitialPath
<font color="blue">If</font> .Show = -<font color="darkblue"><b>1</b></font> <font color="blue">Then</font> GetFolderPath = .SelectedItems(<font color="darkblue"><b>1</b></font>): <font color="blue">If</font> <font color="blue">Not</font> Right$(GetFolderPath, <font color="darkblue"><b>1</b></font>) = PS <font color="blue">Then</font> GetFolderPath = GetFolderPath
<font color="blue">End</font> <font color="blue">With</font>
<font color="blue">End</font> <font color="blue">Function</font>

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

9   голосов , оценка 4.111 из 5
Похожие ответы