| |
環境 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
|
|
ど素人
- 14/9/24(水) 13:06 -
