[[20050427182741]]　『矢印の自動作成』（AKB）　ページの最後に飛ぶ

『矢印の自動作成』（AKB）

 あるセルの値が00のとき、そのセルの右上端に
 オートシェイプ上向き矢印↑を作成し、
 また、別のセルの値が99のときは、そのセルの右下端に
 オートシェイプ下向き矢印下を作成するには、
 どうしたらよいのでしょうか。
 マクロで作成できるのでしょうか?
 どうかよろしくお願いします。

 こんなことじゃないんでしょうが、一応ヒントだけってことで・・
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    Select Case .Value
        Case "00"
            With Me.Shapes.AddLine(.Left + .Width, .Top, .Left + .Width, .Offset(-2).Top).Line
                .EndArrowheadStyle = msoArrowheadTriangle
                .EndArrowheadLength = msoArrowheadLengthMedium
            End With
        Case 99
            With Me.Shapes.AddLine(.Left + .Width, .Top + .Height, .Left + .Width, .Offset(3).Top).Line
                .EndArrowheadStyle = msoArrowheadTriangle
                .EndArrowheadLength = msoArrowheadLengthMedium
            End With
    End Select
End With
End Sub
（SoulMan）

 以前にも類似のものを書いていますが、このようなことは、どうでしょう？　　　　　(LOOKUP)

 １．B列とC列を列幅を狭めておきます。

 ２．B1のセル内に図の↑、B3に↓を貼り付けておきます。

 ３．挿入、名前、定義で、右上の名前を参照範囲=IF(Sheet1!$A$1=99,Sheet1!$B$1,Sheet1!$B$2)、
 　　右下の名前で、=IF(Sheet1!$A$3=99,Sheet1!$B$3,Sheet1!$B$4)を各、登録します。

 ４．C1をコピーして、A1のセルを選択し、編集、Shiftを押しながら図のリンク貼り付け。
 　　同様にC3空白セルをA3に図の貼付をします。図は、A1、A3の右端に移動させます。
 　　A1、A3のセルの書式設定、配置の横位置は、左詰としておきます。

 ５．A1の右に貼り付けた図をクリックして、数式バーに=右上。
 　　同様にA3に貼り付けた図に=右下と入力します。

 これで、準備ができました。A1やA3に99と入力しますと、矢印が表示できます。
 B列C列は、見えない列を使用するほうがよろしいでしょう？

  返事が遅れて申し訳ありません。ありがとうございました。
 おふたりの方法を両方とも試してみましたが、自分の使い方が
 悪いのかどうもうまくいきませんでした。
 SoulManさんのマクロで作成はできたのですが、セルの値を
 クリアしたりすると、エラーがでちゃいます。値を参照して
 オートシェイプを作成するほうがいいのでしょうか。
 Calculateを使ったほうがいいのでしょうか。
 プログラムの知識がないので、うまく伝えられませんが、
 こんなようなことをしたいと思っているんです。
 イメージしか伝えられませんが。

 Sub Arrows()
  Sheets("Sheet1").Activate
   Columns("C:D,G:H,K:L,P:Q,T:U,X:Y").Select
    IF 範囲内に値が8のセルがある(参照も含む) Then
       値が8のセルの右上端に上向き矢印を設定
    Else
      IF 範囲内に値が9のセルがある(参照も含む) Then
         値が9のセルの右下端に下向き矢印を設定
      End IF
    End IF
 End Sub

 Sub DeleteArrows()
  Sheets("Sheet1").Activate
   Columns("C:D,G:H,K:L,P:Q,T:U,X:Y").Select
    IF 範囲内のセルの値が8でも9でもない Then
       そのセルの右上端右下端に設定された矢印を削除(矢印があれば)
    End IF
 End Sub

 というようなマクロを組みたいのです。
 自動でなくてもコマンドボタン登録で問題ないんです。
 とにかく動いてくれさえすればうれしいんです。

 こちらに統合しました。
 （kazu）

『矢印の自動作成その後』（AKB）

  返事が遅れて申し訳ありません。ありがとうございました。
 おふたりの方法を両方とも試してみましたが、自分の使い方が
 悪いのかどうもうまくいきませんでした。
 SoulManさんのマクロで作成はできたのですが、セルの値を
 クリアしたりすると、エラーがでちゃいます。値を参照して
 オートシェイプを作成するほうがいいのでしょうか。
 Calculateを使ったほうがいいのでしょうか。
 プログラムの知識がないので、うまく伝えられませんが、
 こんなようなことをしたいと思っているんです。
 イメージしか伝えられませんが。

 Sub Arrows()
  Sheets("Sheet1").Activate
   Columns("C:D,G:H,K:L,P:Q,T:U,X:Y").Select
    IF 範囲内に値が8のセルがある(参照も含む) Then
       値が8のセルの右上端に上向き矢印を設定
    Else
      IF 範囲内に値が9のセルがある(参照も含む) Then
         値が9のセルの右下端に下向き矢印を設定
      End IF
    End IF
 End Sub

 Sub DeleteArrows()
  Sheets("Sheet1").Activate
   Columns("C:D,G:H,K:L,P:Q,T:U,X:Y").Select
    IF 範囲内のセルの値が8でも9でもない Then
       そのセルの右上端右下端に設定された矢印を削除(矢印があれば)
    End IF
 End Sub

 というようなマクロを組みたいのです。
 自動でなくてもコマンドボタン登録で問題ないんです。
 とにかく動いてくれさえすればうれしいんです。

 回答ではありませんが、
質問の続き、返事は元のスレッドに続けて書きましょうね。
｜初めての方へ｜　をご一読下さいね。
　　　　　　　　　　　　(おせっかい)

 すみません。ちょっと遅くなってしまいました。
こんな感じでどうでしょうか？
Option Explicit
Sub てすと()
Dim S As Shape
Dim C As Range
For Each S In ActiveSheet.Shapes
    If Not Intersect(Selection, Range(S.BottomRightCell.Address)) Is Nothing Then
        If S.Type = msoLine Then
            S.Delete
        End If
    End If
Next
For Each C In Selection
    With C
        Select Case .Value
            Case 8
                With ActiveSheet.Shapes.AddLine(.Left + .Width, .Top, .Left + .Width, .Offset(-2).Top).Line
                    .EndArrowheadStyle = msoArrowheadTriangle
                    .EndArrowheadLength = msoArrowheadLengthMedium
                End With
            Case 9
                With ActiveSheet.Shapes.AddLine(.Left + .Width, .Top + .Height, .Left + .Width, .Offset(3).Top).Line
                    .EndArrowheadStyle = msoArrowheadTriangle
                    .EndArrowheadLength = msoArrowheadLengthMedium
                End With
        End Select
    End With
Next
End Sub
（SoulMan）

まずお詫びから。
スレッド立てしたのは、
問題がまだ解決していなかったということ
それから
お礼をきちんと伝えたかったからということ
です。
大変失礼をいたしました。

SoulManさん、すごいです。
何も問題がなくなりました。
これでお仕事が非常に楽になりました。
何度もありがとうございました。
これですっきりお仕事ができます。
ほんとうにありがとうございました。

 (AKB)

 LOOKUPは、こちらに掲載するときには、必ずテストしています。
 記載の入力誤りはよくしますので、この掲載どおり再度実行しましたが、
 なんら問題なく、期待どおりの結果が得られます。

 図形に名前の定義を通じて別セルをリンクしているだけなのですが、
 通常では行わない特別な入力をするため、要件が実現していないのでは、
 ないでしょうか？以下をご確認ください。

 １．挿入、名前、定義として、名前に右下と右上とが登録されていますか？

 ２．右下の名前の参照範囲は、
 　　=IF(Sheet1!$A$3=99,Sheet1!$B$3,Sheet1!$B$4)
　　右上の名前の参照範囲は、
 　　=IF(Sheet1!$A$1=99,Sheet1!$B$1,Sheet1!$B$2)
 　　となっていますか？

 ３．A1、A3のセルの書式設定、表示形式は、標準。
 　　配置の、文字の配置で横位置は、左詰になっていますか？

 ４．A1、A3のそれぞれのセル内の右側に図形は、貼り付いていますか？

 ５．それぞれの図形をクリックすると、A1の図形は、数式バーに=右上、
 　　A3の図形は、=右下と表示しますか？

 ６．B列、C列は、A列の半分くらいの列幅になっていますか？

 ７．B1に上向き矢印、B3に下向き矢印の図形がセルからはみださずに
 　　貼り付けられていますか？　　　　　　　　　　　　　　　　　　　　　　　　　(LOOKUP)

 LOOKUPさん、気分を害されたならすみませんでした。
 説明不足でした。SoulManさんの方法でもLOOKUPさんの
 方法でも確かに目的のことはできました。また、LOOKUPさんの
 方法ではエラーがでなかったことも確かです。言葉足らずで
 不快な思いをさせて申し訳ありませんでした。
 LOOKUPさんには定義という機能の使い方を
 教えていただきました。またひとつ賢くなりました。
 これに懲りずに機会があれば、また助けてやってください。
 ありがとうございました。
 (AKB)

コメント返信：

[ 一覧(最新更新順) ]

[[20050427182741]] 『矢印の自動作成』（AKB） ページの最後に飛ぶ

[[20050427182741]]　『矢印の自動作成』（AKB）　ページの最後に飛ぶ