Невозможно повернуть изображение в Excel с помощью VBA - PullRequest
Новая
       35

Невозможно повернуть изображение в Excel с помощью VBA

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

Я пытаюсь выбрать определенный диапазон моего рабочего листа, скопировать его, вставить его на временный лист, добавить пиксели ширины и высоты, а затем, наконец, преобразовать его в Worksheet_Name.jpg и сохранить на моем рабочем столе. И это прекрасно работает. Но проблема возникает, когда я пытаюсь повернуть это изображение, пока оно сохраняется на временном листе (это середина, в тройных звездочках). Я продолжаю получать сообщение об ошибке компиляции для ShapeRange о том, что метод или элемент данных не найдены. Пожалуйста помоги. Заранее спасибо. 

    Const FName3 As String = "C:\Desktop\Macro_Summary\Example.jpg"                                         
    Dim pic_rng3 As Range
    Dim ws As Worksheet
    Dim ShTemp3 As Worksheet
    Dim ChTemp3 As Chart
    Dim PicTemp3 As Picture
    Application.ScreenUpdating = False
    Set pic_rng3 = ws.Range("AP1:AT1" & Lastrow)
    Set ShTemp3 = Worksheets.Add
    Charts.Add
    ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp3.Name
    Set ChTemp3 = ActiveChart
    pic_rng3.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ChTemp3.Paste



    ***ChTemp3.ShapeRange.LockAspectRatio = msoFalse
    Dim TargetCells As Range
    With TargetCells
    ChTemp3.Top = .Top
    ChTemp3.Left = .Left
    ChTemp3.Width = .Height
    ChTemp3.Height = .Width
    With ChTemp3.ShapeRange
    .Rotation = 90
    .IncrementLeft ChTemp3.Height / 2 - ChTemp3.Width / 2
    .IncrementTop ChTemp3.Width / 2 - ChTemp3.Height / 2
    End With
    End With***




    Set PicTemp3 = Selection
    With ChTemp3.Parent
    .Width = PicTemp3.Width + 1000
    .Height = PicTemp3.Height + 1000
    End With
    ChTemp3.Export Filename:="C:\Desktop\Macro_Summary\" & ws.Name & ".jpg", FilterName:="jpg"              
    'UserForm1.Image1.Picture = LoadPicture(FName)
    'Kill FName
    Application.DisplayAlerts = False
    ShTemp3.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
...