| |
▼独覚 さん：
返信して下さりありがとうございます。
>まず、
>>ActiveSheet.Shapes.AddConnector(left, top, width, Height).Select
>は
>>ActiveSheet.Shapes.AddConnector(obj, left, top, width, Height).Select
>のミスでしょうか？
ミスです。抜けてしまったようです。申し訳ございません。
>矢印にも種類があるので
取り込む図形をおおよそ持っており、矢印については三角矢印だけでしたのでこうしてしまいました。
おっしゃると通りに書き換えると確かに矢印の形は反映されました。
しかし矢印1本でテストした際、2本描かれるようになってしまい、調べたところ
>>Set wk_中身 = ActiveSheet.Shapes.AddConnector(obj, left, top, width, Height)
で1本目
>>wk_中身.Line.BeginArrowheadStyle = 中身.Line.BeginArrowheadStyle
で2本目が描かれ
>>wk_中身.Line.EndArrowheadStyle = 中身.Line.EndArrowheadStyle
がどうやら2本目に対して実行されているようです。
また
←ーーーーー● (右側が始点)
と描いていたものが
描かれる矢印の2本目で
●ーーーーー→
となってしまいます。
これらの解決方法をいろいろと探ってみたのですが見つけることができませんでした。
もしご存知でしたら教えてくださると大変助かります。
よろしくお願いいたします。
以下にソースコードを示します。
Sub 要素書き出し3_Case()
Dim 要素数 As Integer
Dim 中身 As Variant
Dim left As String
Dim top As String
Dim width As String
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(obj, left, top, width, Height).Select
'-----------変更箇所----------
Dim wk_中身 As Variant
Set wk_中身 = ActiveSheet.Shapes.AddConnector(obj, left, top, width, Height)
wk_中身.Line.BeginArrowheadStyle _
= 中身.Line.BeginArrowheadStyle
wk_中身.Line.EndArrowheadStyle _
= 中身.Line.EndArrowheadStyle
'----------変更箇所終わり-------
'================円============================================================================
'================その他========================================================================
Case Else
'--------------------プロパティー取得-----------------------'
obj = 中身.Type
left = 中身.left
top = 中身.top
width = 中身.width
Height = 中身.Height
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/26(金) 11:51 -
トキノハジメ
- 14/9/26(金) 11:07 -
ペンネーム船長
- 14/9/26(金) 0:50 -
