[[20091231234852]]　『オートシェイプで作った個数を数える』（taka）　ページの最後に飛ぶ

『オートシェイプで作った個数を数える』（taka）

昨日、オートシェイプで丸の中に積を入れるマクロを

ichinoseさんに教えてもらいました。

このオートシェイプで作った丸の中に積が、入った個数を数えたいのですが、

わからないので教えて下さい。

AH=COUNTIF(B4:AF4,"？？？")&"個"

Excel2000　WindowsXP

 関連スレッド
[[20091229141336]]　『オートシェイプ』（taka）

 オートシェイプを描いたときに
 　セルの文字色を白にして
 　セルに「積」の文字を入れる。
 　シェイプを消すときは、セルの文字も消す。
 事にすれば、COUNTIF関数で
 数えられるようになりそうに思います。

 (HANA)

HANAさん　有り難うございます。

 　＞シェイプを消すときは、セルの文字も消す。

ここが、よくわからないので教えて頂けないでしょうか？

宜しくお願い致します。taka

 何が分からないのか良く分かりません。。。

 アクティブセルの文字や書式は
 　ActiveCell.Clear
 で消えますが？

 (HANA)

HANAさん　有り難うございます。

やってみます。taka

[[20091229141336]]　『オートシェイプ』

 ↑これの修正もあるので・・・Countifを使う方法とは違う方法で・・。

 標準モジュールに

 '===============================================================
 Sub オートシェイプ()
    Dim vl As Double
    Dim vt As Double
    Dim vw As Double
    Dim vh As Double
    Dim c As Range
    Dim r As Shape
    Dim t As Shape
    If TypeName(Selection) = "Range" Then
       Set c = Selection
       If c.Width > c.Height Then
          vl = c.Left + c.Width / 2 - c.Height / 2 + 0.75
          vt = c.Top + 0.75
          vw = c.Height - 1.5
          vh = c.Height - 1.5
       Else
          vl = c.Left + 0.75
          vt = c.Top + c.Height / 2 - c.Width / 2 + 0.75
          vw = c.Width - 1.5
          vh = c.Width - 1.5
       End If
       Set r = ActiveSheet.Shapes.AddShape(msoShapeOval, vl, vt, vw, vh)
       r.Line.Visible = True
       Set t = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, vl, vt, vw, vh)
       With t
          With .TextFrame
             With .Characters
                .Text = "積"
                .Font.Size = 10
             End With
             .AutoMargins = False
             .MarginLeft = 0
             .MarginTop = 0
             .MarginBottom = 0
             .MarginRight = 0
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
          End With
          .Fill.Visible = msoFalse
          .Line.Visible = False
       End With
       ActiveSheet.Shapes.Range(Array(t.Name, r.Name)).Group
       ActiveSheet.Calculate
    End If
 End Sub

'==================================================================

 Sub クリア()
     Dim gpo As GroupObject
     For Each gpo In ActiveSheet.GroupObjects
        If Not Application.Intersect(ActiveCell, Range(gpo.TopLeftCell, gpo.BottomRightCell)) Is Nothing Then
           gpo.Delete
           ActiveSheet.Calculate
        End If
     Next
 End Sub
 '====================================================================
 Function 積Count()
    積Count = Application.Caller.Parent.GroupObjects.Count
 End Function

 積の数を出したいセルに

 =積Count()

 と指定します。

 積と円の図形を作成すれば、カウントアップし、削除すればカウントダウンします。
 （但し、提示したマクロを使って作成、削除を行うこと）

 修正箇所は、積と円の図形を若干小さくしました。
 (計算上、セルにぴったり合わせると、上下左右の隣接するセルに作成された図形も削除してしまう
 可能性もあるので）

 ichinose

ichinoseさんお正月早々　わざわざ修正して頂き、有り難うございます。

＞積の数を出したいセルに

　=積Count()をいれましたら、＃NAME？になりました。

　”個”も付け加えたいと思います。宜しくお願い致します。taka

 > =積Count()をいれましたら、＃NAME？になりました。

 Function 積Count()
    積Count = Application.Caller.Parent.GroupObjects.Count
 End Function
 を標準モジュールに記述していますか？

 > ”個”も付け加えたい

 =積Count()&"個"
 とするか、セルの書式設定で設定すればいいかと思います。

 (とおりすがり)

とおりすがりさん　

オートシェイプのSheetに記述していました。

個も無事に付きました。

有り難うございました。

ichinoseさん　本当にお世話になりました。

有り難うございました。

taka

解決したのに何度も申し訳ありません。

＞積の数を出したいセルに　　 =積Count()&"個"

範囲指定したいのですが、

積の数を出したいセルに　(B4:AF4)&"個" の合計

積の数を出したいセルに　(B7:AF7)&"個" の合計

　　　　　・　　　　　　　　・

何度も申し訳ありませんが、宜しくお願い致します。　taka

 >>積の数を出したいセルに　　 =積Count()&"個" 
 >
 > 範囲指定したいのですが、 
 > 積の数を出したいセルに　(B4:AF4)&"個" の合計

 以下のような感じにするといかがですか？

 Function 積Count(rng As Range)
     Dim gpo As GroupObject

     積Count = 0
     For Each gpo In Application.Caller.Parent.GroupObjects
        If Not Application.Intersect(rng, Range(gpo.TopLeftCell, gpo.BottomRightCell)) Is Nothing Then
           積Count = 積Count + 1
        End If
     Next
 End Function

 (VBAメンテ担当)

VBAメンテ担当さん　範囲指定の合計が出来ました。

有り難うございます。

仕事の能率もあがり、出社する足取りが軽くなります。

皆様、本当に有り難うございました。taka

コメント返信：

[ 一覧(最新更新順) ]

[[20091231234852]] 『オートシェイプで作った個数を数える』（taka） ページの最後に飛ぶ

[[20091231234852]]　『オートシェイプで作った個数を数える』（taka）　ページの最後に飛ぶ