Есть ли способ установить путь к файлу динамически, если я пытаюсь вложить файл в Excel VBA? - PullRequest
0 голосов
/ 17 февраля 2020

Ниже приведен код, над которым я пытаюсь работать. Я новичок в Excel VBA.

    Sub Test1()
      Dim x As Integer
      Application.ScreenUpdating = False
      ' Set numrows = number of rows of data.
      NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
           For x = 1 To NumRows
         ActiveSheet.OLEObjects.Add(Filename:= _
        "Filelocation\filename.extension" _
        , Link:=False, DisplayAsIcon:=True, IconFileName:="C:\Windows\Installer\{90160000-000F-0000-1000-0000000FF1CE}\wordicon.exe", _
        IconIndex:=0, IconLabel:= _
        "Filelocation\filename.extension" _
        ).Select

        ActiveCell.Offset(1, 0).Select
        Next
      Application.ScreenUpdating = True
    End Sub

Здесь я хочу прикрепить следующий файл в папке. На данный момент с этим кодом, я могу прикрепить один и тот же файл несколько раз. Мое требование состоит в том, чтобы прикреплять разные файлы в разные ячейки при перемещении вниз Надеюсь вопрос был понятен:)

1 Ответ

0 голосов
/ 16 апреля 2020

Я создал лист с именем Control, в котором находится расположение файлов, которые необходимо прикрепить, с помощью кнопки с назначенным ему макросом ниже.

Sub fileInsertionForRetest()
On Error GoTo er
    Dim x As Integer
    Dim NumRows As Long
    Worksheets("Retest").Activate
    Application.ScreenUpdating = False
    Range("G2").Select
    NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
        For x = 1 To NumRows


           Range("B" & x + 1&).EntireRow.RowHeight = 60

            ActiveSheet.OLEObjects.Add(Filename:= _
            ThisWorkbook.Sheets("Control").Range("B2").Value & Range("A" & x + 1&).Value & ".docx", Link:=False, DisplayAsIcon:=True, _
            IconFileName:="C:\Windows\Installer\{90160000-000F-0000-1000-0000000FF1CE}\wordicon.exe", _
            IconIndex:=0, IconLabel:=Range("A" & x + 1&).Value).Select

            ActiveCell.Offset(1, 0).Select
        Next
    Application.ScreenUpdating = True
Done:
    MsgBox "All file were attached successfully"
    Exit Sub
er:
MsgBox "The following error occurred: " & err.Description
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...