Перечисление xlPlacement с вставленными объектами в VBA для Excel? - PullRequest
Новая
       15

Перечисление xlPlacement с вставленными объектами в VBA для Excel?

0 голосов
/ 30 октября 2018

Я пишу макрос, который копирует диаграммы из xSheet1 и вставляет их в xSheet2 как изображения. Я хотел бы дать фотографиям свойство xlMoveAndSize, но я не могу найти хороший способ сделать это.

Я пытался сделать что-то вроде этого: 

For Each xPic In xSheet2.Pictures
    xPic.Placement = xlMoveAndSize
Next

Единственная проблема этого метода заключается в том, что мой xSheet2 содержит тысячи картинок, и для их просмотра требуется много времени. Сбросить свойство xlMoveandSize для всех из них, кроме 8 последних вставленных изображений, излишне, поэтому, если бы я мог каким-либо образом ссылаться только на эти изображения или назначать их объектам изображений при вставке их в лист, я мог бы значительно сократить время требуется, чтобы запустить текущий дизайн.

Когда изображения вставляются в xSheet2, им необязательно присваиваются имена от "Изображение 1" до "Изображение 8" (или от "Изображение n-8" до "Изображение n"), поэтому я не верю, что я Я могу назвать фотографии по имени, если я не смогу указать их имя до их вставки. Если бы я мог «вставить» картинки прямо в переменную, это было бы идеально, хотя я думаю, что с этой идеей может возникнуть фундаментальная проблема.

Единственный другой обходной путь, о котором я могу подумать, - это экспортировать диаграммы из xSheet1 в виде картинок и сохранять их во временном кэше на жестком диске пользователя с помощью чего-то вроде: xChart1.Export Filename:="C:\CachePath\Chart1", Filtername:="PNG" и импортировать их в xSheet2 с чем-то вроде xPic1=xlApp.xSheet2.Pictures.Insert("C:\CachePath\Chart1"). Я действительно хотел бы избежать этого, если это возможно.

Вот как я сейчас перемещаю картинки: 

Sub GetChartPics()

'Variables
    Dim xSheet1 as Worksheet        'source
    Dim xSheet2 as Worksheet        'destination
    Dim xChart1 as ChartObject      'chart1 from source
    Dim xChart2 as ChartObject      'chart2 from source
    '...
    Dim xChart8 as ChartObject      'chart8 from source
    Dim xPic as Picture

'Set chart objects and worksheets
    'I'll spare the details here. I don's see how they'd be relevant, anyway.

'Move Charts
    Application.CutCopyMode = False
    xChart1.Chart.CopyPicture
    xSheet2.Paste Destination:=xSheet2.Range("A3")

    Application.CutCopyMode = False
    xChart2.Chart.CopyPicture
    xSheet2.Paste Destination:=xSheet2.Range("B3")

    '...

    Application.CutCopyMode = False
    xChart8.Chart.CopyPicture
    xSheet2.Paste Destination:=xSheet2.Range("H3")

'AssignMoveAndSize Property to pics
    For Each xPic in xSheet2.Pictures
        xPic.Placement = xlMoveAndSize
    Next

Спасибо

Ответы [ 2 ]

0 голосов
/ 02 ноября 2018

Имя фигуры может не иметь ничего общего с индексом фигуры в коллекции Shapes.

Вот что я предлагаю вам использовать: 

xChart8.Chart.CopyPicture
xSheet2.Paste Destination:=xSheet2.Range("H3")

With xSheet2
    .Shapes(.Shapes.Count).Placement = xlMoveAndSize
End With

Я никогда не видел, чтобы вставленная фигура не была последней индексной позицией на листе.

0 голосов
/ 02 ноября 2018

Я обнаружил, что макрос работает намного быстрее, если вместо For Each xPic in XSheet2.Pictures я использую For Each xShape in xSheet2.Shapes. Это имеет тот же эффект и, хотя быстрее, все же занимает немного времени. Чтобы сделать макрос немного более эстетичным, я просто отображаю немодальную форму пользователя, которая говорит «пожалуйста, подождите ...», пока макрос работает в фоновом режиме. Это решение работает достаточно хорошо для моей цели.

Это сокращение от того, как выглядит код сейчас: 

Sub GetChartPics()

'Variables
    Dim xSheet1 as Worksheet        'source
    Dim xSheet2 as Worksheet        'destination
    Dim xChart1 as ChartObject      'chart1 from source
    Dim xChart2 as ChartObject      'chart2 from source
    '...
    Dim xChart8 as ChartObject      'chart8 from source
    Dim xShp as Shape

'Show modeless userform
    Load PleaseWait
    PleaseWait.Show (0)

'Set chart objects and worksheets
    'I'll spare the details here. I don's see how they'd be relevant, anyway.

'Move Charts
    Application.CutCopyMode = False
    xChart1.Chart.CopyPicture
    xSheet2.Paste Destination:=xSheet2.Range("A3")

    Application.CutCopyMode = False
    xChart2.Chart.CopyPicture
    xSheet2.Paste Destination:=xSheet2.Range("B3")

    '...

    Application.CutCopyMode = False
    xChart8.Chart.CopyPicture
    xSheet2.Paste Destination:=xSheet2.Range("H3")

'Assign MoveAndSize Property to Shapes
    For Each xShp in xSheet2.Shapes
        xShp.Placement = xlMoveAndSize
    Next

'Close Userframe
    Unload PleaseWait
...