Сообщения

Я бы понял, и не такое понимали

ну да, ну да
Тогда вопрос: а обязательно вставлять именно как мета-файл? В этом есть какой-то определенный смысл? Не пробовали вставлять как Shape, например? Вставляется не вся информация или это просто недопустимо?

При чём тут имитация ПКМ?

вот при чём:

если нажать ПКМ и выбрать Изменение рисунка - становится видимым полностью и при конвертации в инлайн остаётся полным. Как это выполнить на VBA?

Вы бы сами поняли себя, если бы так поставили задачу? Описали кучу действий и только один вопрос: как это выполнить. Я и задал первым делом вопрос: что именно "это"? И дальше уже стал описывать, какие варианты понимания задачи появляются при подобной их постановке.

Насчет команды "Изменить изображение". У меня её вообще нет - все действия по редактированию выполняются с панели при выделенном изображении. Да я и не помню, чтобы такая команда была. Изменить изображение появляется один раз - при вставке изображения. В дальнейшем его можно заменить или изменять свойства и параметры через панель.
Вам точно надо именно "Изменить изображение"? Какова конечная цель выполнения этой команды? Может быть можно найти другие пути решения - если знать, что именно искать.

Как это выполнить на VBA

Это - это что? ПКМ по рисунку? Конвертирование? Конкретизируйте. Картинка не подгружается и что Вы там делаете и что надо вообще непонятно.
Конвертировать: h.ConvertToInlineShape
ПКМ - нельзя имитировать простыми средствами, там надо через API заморачиваться. Проще докопаться до причины. Возможно глюк или неполная прорисовка сразу после вставки и нужно время(тот же цикл от 1 до 100 с DoEvents)

линии не переносятся

сделали бы на листе ФИЛЬТР эти линии через границы ячеек, а не фигурами - тогда и лишних телодвижений не потребовалось бы.
Ну а без этого - можно накрутить лишнего(что не всегда хорошо):

Код Выделить Развернуть

Sub iSort_()
Dim Itog As Worksheet, wsFilter As Worksheet
Dim iLastRow As Long
Dim i As Long
Dim sh As Shape
  Set wsFilter = ActiveSheet
  Set Itog = ThisWorkbook.Worksheets("Итог")
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    With Itog
      .Cells.Clear
      .DrawingObjects.Delete
      wsFilter.Range("A1:J" & iLastRow + 1).Copy .Cells(1, 1)
      .Cells.UnMerge
      .Cells.Value = Empty
      wsFilter.Range("A1:J" & iLastRow + 1).Copy
      .Cells(1, 1).PasteSpecial xlPasteValues
      .Cells(1, 1).PasteSpecial xlPasteFormats
      Application.CutCopyMode = False
        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
      .Range("A22:J" & iLastRow).Sort Key1:=.Range("F4"), Order1:=xlAscending, Header:=xlYes
'        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
       
        .Range("A23") = 1
        .Range("A23").DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Stop:=iLastRow - 22, Trend:=False

       
        For i = iLastRow To 23 Step -1
        If IsDate(.Cells(i - 1, "F")) Then
          If Month(.Cells(i, "F")) <> Month(.Cells(i - 1, "F")) Then
            .Rows(i).Insert
            .Range("A" & i & ":J" & i).Merge
            .Range("A" & i).HorizontalAlignment = xlCenter
            .Range("A" & i) = Format(.Cells(i + 1, "F"), "MMMM")
          End If
        End If
        Next
            .Range("A23").EntireRow.Insert
            .Range("A23 :J23").Merge
            .Range("A23 :J23").HorizontalAlignment = xlCenter
            .Range("A23 :J23") = Format(.Cells(24, "F"), "MMMM")
    End With
End Subда, заменил цикл по фигурам на одну строку удаления - цикл лишний, от слова совсем, да еще с Like на любую строку.

Попробуйте заменить эту строку:

Код Выделить Развернуть

Range("A1:J" & iLastRow).Copy .Cells(1, 1)на такие:

Код Выделить Развернуть

Range("A1:J" & iLastRow).Copy
.Cells(1, 1).PasteSpecial xlPasteValues
.Cells(1, 1).PasteSpecial xlPasteFormats
Application.CutCopyMode = false

подсказки не появляются

у меня появляются. Наводите на иконку, ждете секунду - всплывает подсказка.

Kuzmich - Коды оформляйте тегами Code(Код). п.п. 4.25 Правил форума.
Я не могу постоянно делать это за Вас

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

Там почти все править надо. Возьмите код из ссылки, которую я выше скидывал. Там код как раз берет и файлы в папке и в подпапках. А в приложенном Вами - только в одной папке.
А сама ошибка означает, что некорректное имя файла. Возможно, проблема в том, что Вы пытаетесь перебрать все файлы, а не только файлы Excel. А там могут быть и временные, и скрытые, и системные.

Вместо этого куска:

Код Выделить Развернуть

On Error Resume Next
        appExcel.Workbooks.Open fullPath
        If Err.Number <> 0 Then
            newName = "ПОДОЗРИТЕЛЬНЫЙ_ФАЙЛ_" & fileName
            fso.MoveFile fullPath, folderPath & newName
            Err.Clear
        Else
            appExcel.ActiveWorkbook.Close
        End Ifпопробуйте вот такой:

Код Выделить Развернуть

On Error Resume Next
set wb = Nothing
set wb = appExcel.Workbooks.Open(fullPath)
If wb is Nothing Then
    newName = "ПОДОЗРИТЕЛЬНЫЙ_ФАЙЛ_" & fileName
    fso.MoveFile fullPath, folderPath & newName
    Err.Clear
Else
    ws.Close 0
End IfИ где-нибудь вверху добавьте объявление:

Код Выделить Развернуть

Dim wb As Object
И не забывайте оформлять коды соответствующими тегами.

А хоть что-то Вы уже попробовали? И что значит "проблемы с открытием"? Какого рода проблемы? И формат файлов не забудьте уточнить.
Про просмотр файлов в папке на сайте есть статья: Просмотреть все файлы в папке
Останется лишь добавить проверку на "проблему с открытием".

Нет. Но в Вашем случае это просто некая "хитрость", чтобы заставить программу отбирать значения, разбросанные подобным образом. И то не все и не всегда.
У Вас клиенты записаны напротив каждого договора - а программа отбирает по сути те строки, у которых максимальный уровень группировки в таблице. Тоже и с отсрочкой.
Если бы эти данные были записаны "по правилам" - для каждой самой детализированной строки - то можно было бы обойтись без финтов - приложил скрин настроек, если бы в строке(например, 26) были бы продублированы данные по клиенту и отсрочке.
Т.е. для перевода такой таблицы в нормальную плоскую надо что-то отдельное делать, т.к. разбивка данных отличается несколько от классических.
Вам вообще проще собрать основные данные через надстройку, а потом клиентов и отсрочки через ВПР подтянуть на основании договора. Быстрее будет.

Этого файла больше нет, поэтому скинуть не смогу.

В Вашем случае я бы сделал в несколько ходов - уж очень разбросаны по структуре дополнительные данные.
Сначала заполняете все ячейки клиентами: выделяете диапазон С15:С88 -MulTEx -Диапазоны -Автозаполнение строк. Параметр "Ячейка с которой начать заполнение" - С15. Скрин приложил.
Тоже самое с отсрочкой(и другими подобными столбцами).
Потом приводите заголовки в порядок(это больше для того, чтобы в итоговой форме заголовки прописались). Я снял объединение и записал все заголовки в одну строку 12.
А далее применяете настройки со скрина.

Тема перенесена в соответствующий раздел - на форуме есть отдельная ветка для обсуждений проблем и вопросов, связанных с надстройкой MulTEx.
По сути - ниже скрин, как можно сделать. Сама проблема в том, что клиенты у Вас записаны не в первой строке договора, поэтому надо слегка "помудрить" с указанием заголовков.