Excel VBA質問箱 IV

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

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


6235 / 76734 ←次へ | 前へ→

【76101】Re:シート上の図形の再描写
発言  ど素人  - 14/9/25(木) 15:27 -

引用なし
パスワード
   ▼独覚 さん:

返信して下さりありがとうございます。
>まず、
>>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

2 hits

【76096】シート上の図形の再描写 ど素人 14/9/24(水) 13:06 質問
【76098】Re:シート上の図形の再描写 独覚 14/9/24(水) 14:30 発言
【76101】Re:シート上の図形の再描写 ど素人 14/9/25(木) 15:27 発言
【76102】Re:シート上の図形の再描写 独覚 14/9/25(木) 16:14 発言
【76099】Re:シート上の図形の再描写 独覚 14/9/24(水) 16:45 発言
【76120】Re:シート上の図形の再描写 ど素人 14/9/30(火) 14:40 お礼

6235 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free