Вставить изображения, чтобы они были доступны при отправке внешним лицам - PullRequest
Новая
       16

Вставить изображения, чтобы они были доступны при отправке внешним лицам

0 голосов
/ 10 октября 2019

У меня есть документ с VBA, который вставляет изображения на основе путей к файлам, но когда я сохраняю файл и отправляю электронное письмо другим лицам, изображения не отображаются. Документ используется в качестве основного документа. Пути к файлам для каждого изображения определяются форумом в каждой ячейке, поэтому они варьируются от ячейки к ячейке и от документа к документу - поэтому использование пути к файлу в коде невозможно.

Я хотел бы встроитьизображения, чтобы после сохранения файла изображения были доступны любому, кто откроет файл. Прямо сейчас я вручную выбираю все объекты и делаю копирование, чтобы обойти проблему. Если есть способ кодирования, выберите все объекты и скопируйте вставку, которая может работать, но все, что я нашел для этого, вставьте изображения в другое место, в которое они были первоначально вставлены ...

Воткод, который я использую для первоначальной вставки изображений: 

Sub URLInsertPicture()
    Dim Pshp As Shape
    Dim xRg As Range
    Dim xCol As Long

    On Error Resume Next
    Application.ScreenUpdating = False
    Set Rng = ActiveSheet.Range("B52")
    For Each cell In Rng
    filenam = cell
    ActiveSheet.Pictures.Insert(filenam).Select
    Set Pshp = Selection.ShapeRange.Item(1)
    If Pshp Is Nothing Then GoTo lab
    xCol = cell.Column
    Set xRg = Cells(cell.Row, xCol)
    With Selection
            .ShapeRange.LockAspectRatio = msoTrue
            If (.Height \ .Width) <= (Rng.Height \ Rng.Width) Then
                .Width = Rng.Width - 1
                .Left = Rng.Left + 1
                .Top = Rng.Top + ((Rng.Height - Selection.Height) / 2)
            Else
                .Top = Rng.Top + 1
                .Height = Rng.Height - 1
                .Left = Rng.Left + ((Rng.Width - Selection.Width) / 2)
            End If

            .Placement = xlMoveAndSize
            .PrintObject = True
    End With
lab:
    Set Pshp = Nothing
    Range("B52").Select
    Next
    Application.ScreenUpdating = True
End Sub

Было бы очень полезно, если бы вы могли предоставить свои ответы в качестве модификации моего кода, поскольку другие переменные должны остаться неизменными, и я новичок в VBA.

Спасибо

...