Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6240 / 76734

←次へ　｜　前へ→


	【76096】シート上の図形の再描写

ど素人 - 14/9/24(水) 13:06 -


	引用なし

	パスワード

環境　excel 2013

　現在シート上に作成された図形や矢印などを取り込み、コピーではなく再描写させるプログラムを作成しております。

　しかし作成したのプログラムでは把握している範囲で次のような問題があります。
　　・矢印の向きが再現されない
　　・矢印の太さが設定していないにもかかわらず太くなることがある。
　　・曲線矢印が直線になってしまう
　　・円が描写されない
　　・グループ化されている場合、グループ化を手動で解除しなければ正しく取り込まれない
　　
　これらを解決するにはどのようにしたらよいか、ご教授いただけないでしょうか？
　よろしくお願いいたします。

以下作成したプログラム

Sub 要素書き出し3_Case()

　　Dim 要素数 As Integer
　　Dim 中身 As Variant
　　Dim left As Double
　　Dim top As Double
　　Dim width As Double
　　Dim Height As String
　　Dim obj As String
　

　　要素数 = 1
　　　　For Each 中身 In ActiveSheet.Shapes

　　　　　　'--------------------プロパティー表示-----------------------'
　　　　　　　　　Cells(要素数 + 2, 1) = 中身.Name
　　　　　　　　　Cells(要素数 + 2, 2).Value = 中身.AutoShapeType

　　
　　　　　　Select Case True
'==================コネクター================================================================
　　
　　　　　　　　　　　Case 中身.Connector
　　　　　　　　'--------------------プロパティー取得-----------------------'
　　　　　　　　　　　　obj = 中身.Type
　　　　　　　　　　　　left = 中身.left
　　　　　　　　　　　　top = 中身.top
　　　　　　　　　　　　width = 中身.width + 中身.left
　　　　　　　　　　　　Height = 中身.Height + 中身.top

　　　　　　　　　　　　　If 中身.Line.BeginArrowheadStyle = msoArrowheadTriangle Then
　　　　　　　　　　　　　　
　　　　　　　　　　　　　　　　　　Cells(要素数 + 2, 7) = "msoArrowheadTriangle"
　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　　
　　　　　　　　　　　　　If 中身.Line.EndArrowheadStyle = msoArrowheadTriangle Then
　　　　　　　　　　　　　　
　　　　　　　　　　　　　　　　　　Cells(要素数 + 2, 8) = "msoArrowheadTriangle"
　　　　　　　　　　　　　　　End If
　　　　　　　　　　 '--------------------図形書きだし-----------------------'
　　　　　　　　　
　　　　　　　　　　　　　　 ActiveSheet.Shapes.AddConnector(left, top, width, Height).Select
　　　　　　　　　　　
　　　　
　　　　　　　　　　　　　If 中身.Line.BeginArrowheadStyle = msoArrowheadTriangle Then
　　　　　　　　　　　　　　　　　Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
　　　　　　　　　　　　　　 End If
　　　　
　　　　　　　　　　　　　If 中身.Line.EndArrowheadStyle = msoArrowheadTriangle Then
　　　　　　　　　　　　　　　　　Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
　　　　　　　　　　　　　　 End If

'================円============================================================================

'================その他========================================================================

　　　　　　　　　
　　　　　　　　　　　 Case Else
　　　　　　　　　　　　'--------------------プロパティー取得-----------------------'
　　　　　　　　　　　　　　　　obj = 中身.Type
　　　　　　　　　　　　　　　　left = 中身.left
　　　　　　　　　　　　　　　　top = 中身.top
　　　　　　　　　　　　　　　　width = 中身.width
　　　　　　　　　　　　　　　　Height = 中身.Height
　　　　　　　　　　　　　　　　
　　　　　　　　　　　　'--------------------図形書きだし-----------------------'
　　　　　　　　　　　　ActiveSheet.Shapes.AddShape(obj, left, top, width, Height).Select
　　　　　　　　　　　　　　　　Selection.ShapeRange.Name = "test 図形" & 要素数

　　　　　　　　 End Select
　　
　　'--------------------プロパティー表示----------------------'
　　　　　　Cells(要素数 + 2, 2).Value = obj
　　　　　　Cells(要素数 + 2, 3).Value = left
　　　　　　Cells(要素数 + 2, 4).Value = top
　　　　　　Cells(要素数 + 2, 5).Value = width
　　　　　　Cells(要素数 + 2, 6).Value = Height
　　　　　
　　　　　要素数 = 要素数 + 1
　　　　　　　　　　
　　　 Next

End Sub

2 hits

▼

【76096】シート上の図形の再描写 ど素人 14/9/24(水) 13:06

≪