none
Excel-VBA 図形ツール[書式]・トリミングについて RRS feed

  • 質問

  • ワークシートに張付けた画像をクリックした時に表示される、
    [リボン]⇒図ツール[書式]タブ⇒[サイズ]⇒[トリミング]▼の、
    ①トリミング(C)
    ②図形に合わせてトリミング(S)…
    ③縦横比(A)…
    ④塗りつぶし(L)
    ⑤枠に合わせる(T)
    マクロ記録が出来ません…!?
    使用したPCは、Windows7(32bit)-Excel2010(32bit)です。
    先ずは①④⑤をVBAで実行するコードを教えて下さい。
    宜しくお願い致します。
    2015年1月21日 15:54

回答

  • こんにちは。

    ①と②について以下に記載します。
    ③以降はリファレンスで見当たらなかったので手動計算して対応するしかないかもしれませんね。

    Sub トリミング()
        With ActiveSheet.Shapes(1)
            .PictureFormat.CropBottom = .PictureFormat.CropBottom + 10
            .PictureFormat.CropLeft = .PictureFormat.CropLeft + 10
            .PictureFormat.CropRight = .PictureFormat.CropRight + 10
            .PictureFormat.CropTop = .PictureFormat.CropTop + 10
        End With
    End Sub
    
    Sub 図形に合わせてトリミング()
        With ActiveSheet.Shapes(1)
            .AutoShapeType = msoShapeRoundedRectangle
        End With
    End Sub
    

    • 回答としてマーク sakuraxx 2015年1月27日 16:39
    2015年1月22日 2:50
    モデレータ
  • 大変お世話になっております。
    課題の①②供に実験が成功しました…感謝
    <参考>.AutoShapeType「mso図形137個」の先頭から15個を連続表示します。
    Sub ②図形に合わせてトリミング()
        Dim i As Integer
        Dim ObjName As String
        With ActiveSheet.Shapes(1)
            .AutoShapeType = msoShapeRoundedRectangle
            For i = 1 To 15
                If Application.Wait(Now + TimeValue("0:00:01")) Then
                    .AutoShapeType = i
                End If
            Next
            .AutoShapeType = 96
        End With
        MsgBox "◎◎◎処理完了◎◎◎", 64
    End Sub

    sakuraxx

    • 回答としてマーク sakuraxx 2015年1月27日 16:40
    2015年1月26日 17:16

すべての返信

  • こんにちは。

    ①と②について以下に記載します。
    ③以降はリファレンスで見当たらなかったので手動計算して対応するしかないかもしれませんね。

    Sub トリミング()
        With ActiveSheet.Shapes(1)
            .PictureFormat.CropBottom = .PictureFormat.CropBottom + 10
            .PictureFormat.CropLeft = .PictureFormat.CropLeft + 10
            .PictureFormat.CropRight = .PictureFormat.CropRight + 10
            .PictureFormat.CropTop = .PictureFormat.CropTop + 10
        End With
    End Sub
    
    Sub 図形に合わせてトリミング()
        With ActiveSheet.Shapes(1)
            .AutoShapeType = msoShapeRoundedRectangle
        End With
    End Sub
    

    • 回答としてマーク sakuraxx 2015年1月27日 16:39
    2015年1月22日 2:50
    モデレータ
  • 大変お世話になっております。
    課題の①②供に実験が成功しました…感謝
    <参考>.AutoShapeType「mso図形137個」の先頭から15個を連続表示します。
    Sub ②図形に合わせてトリミング()
        Dim i As Integer
        Dim ObjName As String
        With ActiveSheet.Shapes(1)
            .AutoShapeType = msoShapeRoundedRectangle
            For i = 1 To 15
                If Application.Wait(Now + TimeValue("0:00:01")) Then
                    .AutoShapeType = i
                End If
            Next
            .AutoShapeType = 96
        End With
        MsgBox "◎◎◎処理完了◎◎◎", 64
    End Sub

    sakuraxx

    • 回答としてマーク sakuraxx 2015年1月27日 16:40
    2015年1月26日 17:16