2017-05-24 15 views
0

こんにちは、コメントの図形の図形(塗りつぶし)と標準の高さと幅のファイル形式を変更したい。次のコードを試してみましたが、アプリケーション定義のエラー "Run time error 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

フォーマット変更してみてください:JPGは、ビットマップ形式の画像であるため、= xlBitmap:フォーマットへ= xlPictureを。 MSから以下を参照してください。 https://msdn.microsoft.com/en-us/library/office/ff837557.aspx

https://msdn.microsoft.com/en-us/library/office/ff195475.aspx

+0

いや、機能していません。 – Joe

+0

あなたのソリューションにFormat:= xlBitmap?あなたは歓迎です –

+0

問題はChartObjectsでフォーマットではありません。私はchartObjectsでChartsを変更する必要があります。 – Joe

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 
関連する問題