2017-05-24 20 views
0

嗨我想更改評論形狀圖片(填充)的文件格式,以及標準的高度和寬度。嘗試了下面的代碼,但它繼續拋出應用程序定義的錯誤「運行時錯誤1004」。請指導我糾正這一問題。更改Excel註釋形狀圖片文件格式

Sub ReduceImageSize() 

    Dim cmt As Comment 
    Dim MyChart As Chart 
    Dim MyPicture As String 
    Dim pic As Object 
    Dim PicWidth As Long 
    Dim PicHeight As Long 
    Dim num As Long 
    num = 1 
    Application.ScreenUpdating = False 
    For Each cmt In ActiveSheet.Comments 
     With cmt 
      .Visible = True 
      .Shape.CopyPicture Appearance:=xlScreen, Format:=xlPicture 
      .Visible = False 
      PicHeight = .Shape.Height 
      PicWidth = .Shape.Width 

      Set MyChart = Charts.Add(0, 0, 100, 100).Chart 
       With MyChart.Parent 
        .Width = PicWidth 
        .Height = PicHeight 
        .ChartArea.Select 
        .Paste 
        .ChartObjects(1).Chart.Export Filename:="C:\Temp\MyPic " & num & ".jpg", FilterName:="jpg" 
       End With 
       .Shape.Fill.UserPicture PictureFile:="C:\Temp\MyPic " & num - 1 & ".jpg" 
       num = num + 1 
       ActiveChart.Delete 

      End With 

    Next 
    Application.ScreenUpdating = True 
End Sub 

回答

0

找到了解決辦法:

Option Explicit 
Sub ReduceImageSize() 
    Dim cmt As Comment 
    Dim MyChart As ChartObject 
    Dim MyPicture As String 
    Dim pic As Object 
    Dim PicWidth As Long 
    Dim PicHeight As Long 
    Dim num As Long 
    Dim Mysheet As Worksheet 
    num = 1 
    Application.ScreenUpdating = False 
    For Each Mysheet In ThisWorkbook.Worksheets 
    For Each cmt In ActiveSheet.Comments 
     With cmt 
      .Visible = True 
      .Shape.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 
      .Visible = False 
      PicHeight = .Shape.Height 
      PicWidth = .Shape.Width 

      Set MyChart = ActiveSheet.ChartObjects.Add(0, 0, 100, 100) 
       With MyChart 
        .Activate 
        .Width = PicWidth 
        .Height = PicHeight 
        .Chart.Paste 
        '.ChartArea.Select 
        '.Paste 
        .Chart.Export Filename:="C:\Temp\MyPic " & num & ".jpg", FilterName:="jpg" 
       End With 
       .Shape.Fill.UserPicture PictureFile:="C:\Temp\MyPic " & num & ".jpg" 
       num = num + 1 
       MyChart.Delete 
      End With 
     Next 
     Application.ScreenUpdating = True 
    Next 
End Sub