[[20100326121043]]　『条件によって丸で囲む』（あ）　ページの最後に飛ぶ

『条件によって丸で囲む』（あ）

   A       B      C

1 男　　　男　　　女

A1に男または女が入ります。
A1が男の場合B1の男を丸で囲み、A1が女の場合C1を丸で囲みたいのですが、できますか？

 マクロであればできなくはないですが、条件付き書式で背景に色を付ける程度では
 ダメなのでしょうか。
 (Mook)

 2003で確認してみたら、IMEパッドの中にあったので、
 B1
 =if(a1="男","㊚","男")
 C1
 =if(a1="女","㊛","女")
 とか。
 （文字化けしていたらすみません。）
 BJ

BJさんありがとうございます。
さっそくやってみました。私の言いたいことズバリだったのですが、IMEパッドだと文字が小さくてセルのフォントサイズを変更したら、○で囲ってないときの文字が大きくなってしまします。
マクロでできるのであれば、教えていただけないでしょうか？
A1は入力規則のリストで男、女をプルダウンで選ぶようになっています。
よろしくお願いします。

（あ）

 マクロではないですが…こんなことじゃないかな？

 https://www.excel.studio-kazu.jp/kw/20040827171629.html
[[20040827171629]]　『マクロかな？』（のりぞー）

　(ぞうちゃん)

 こんな方法もありますから、新規ブックにて試してみてください。

 まず標準モジュールに

 '=============================================================================
 Option Explicit
 Sub mk_sample()
    With 丸囲い文字作成(Range("b1"), "男")
       .Name = "男"
       .GroupItems(1).Line.Visible = msoFalse
    End With
    With 丸囲い文字作成(Range("c1"), "女")
       .Name = "女"
       .GroupItems(1).Line.Visible = msoFalse
    End With
 End Sub
 '===============================================================
 Function 丸囲い文字作成(c As Range, mystr As String) As Shape
    Dim vl As Double
    Dim vt As Double
    Dim vw As Double
    Dim vh As Double
    Dim r As Shape
    Dim t As Shape
    If c.Width > c.Height Then
       vl = c.Left + c.Width / 2 - c.Height / 2
       vt = c.Top
       vw = c.Height
       vh = c.Height
    Else
       vl = c.Left
       vt = c.Top + c.Height / 2 - c.Width / 2
       vw = c.Width
       vh = c.Width
    End If
    Set r = c.Parent.Shapes.AddShape(msoShapeOval, vl, vt, vw, vh)
    r.Line.Visible = True
    Set t = c.Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, vl, vt, vw, vh)
    With t
       With .TextFrame
          With .Characters
             .Text = mystr
             .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
    Set 丸囲い文字作成 = c.Parent.Shapes.Range(Array(t.Name, r.Name)).Group

 End Function
 '==================================================================
 Sub クリア()
     ActiveSheet.GroupObjects.Delete
 End Sub

 上記、mk_sampleを実行してみてください。

 セルB1、C1に　男　女　という図形が作成されます。

 次にこの図形が作成されたシートのモジュール（標準モジュールではないですよ）に

 '===========================================================================
 Option Explicit
 Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("a1")) Is Nothing Then
       With Range("a1")
          Shapes("男").GroupItems(1).Line.Visible = msoFalse
          Shapes("女").GroupItems(1).Line.Visible = msoFalse

          If .Value = "男" Then
             Shapes("男").GroupItems(1).Line.Visible = msoTrue
          ElseIf .Value = "女" Then
             Shapes("女").GroupItems(1).Line.Visible = msoTrue
          End If
       End With
    End If
 End Sub

 これで当該シートのセルＡ１に　男　と入力してください。

 また、女　と入力してください。　ご希望の表示になりませんか？

 試してみてください。

 ichinose

ichinose　様　マクロで動くように作ってくださってありがとうございます。
マクロを試してみましたら、うまく動作しましたが、ちょっと自分の作成したいものと違ってましたので
ichinose　様の作成していただいたものを参考に自分の作成したいものにあてはめて作成してみました。
マクロ初心者でほとんどわからないので、教えていただけますか？

 　Ｂ       Ｄ      Ｅ
２ 男　　　男　　　女

次のようなものが入力されています。
Ｂ２が男の場合Ｄ２に○、Ｂ２が女の場合Ｅ２に○をつけたいのです。

標準モジュールにこんなマクロを作成してみました。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

　　ActiveSheet.Shapes.AddShape(msoShapeOval, 203.25, 13.5, 17.25, 15.75).Select

    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 65
    Selection.ShapeRange.Fill.Transparency = 1#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

    ActiveSheet.Shapes.AddShape(msoShapeOval, 169.5, 13.5, 17.25, 15.75).Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 65
    Selection.ShapeRange.Fill.Transparency = 1#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End Sub

シートモジュールに

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("Ｂ２")) Is Nothing Then
       With Range("Ｂ２")
           ActiveSheet.Shapes.AddShape(msoShapeOval, 203.25, 13.5, 17.25, 15.75).Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 65
    Selection.ShapeRange.Fill.Transparency = 1#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

    ActiveSheet.Shapes.AddShape(msoShapeOval, 169.5, 13.5, 17.25, 15.75).Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 65
    Selection.ShapeRange.Fill.Transparency = 1#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

          If .Value = "男" Then

          ElseIf .Value = "女" Then

          End If
       End With
    End If
 End Sub

=============================================================

以上のようなマクロだとＤ２もＥ２も同時に○がついてしまいます。
同時に○がつくのではなく、男だったら男に○、女だったら女に○をつけたいのです。

あと○をつけたあとオートシェイプを解除したいです。
よろしくお願いします。

 マクロを使わないでする方法として、以下のサイトが参考になると思います。

 http://www.officetanaka.net/excel/function/tips/tips14.htm　自動的に画像を切り替える

 どこか適当なセルに、男の位置に○・女の位置に○・○なし（○はオートシェイプで）を作り、
 そこにリンクさせれば画像の切り替えで対応できると思います。

　(フェンリル)

マクロではできませんか？マクロよく理解してなくて、書いているので助けていただけたらありがたいです。

（あ）

 新規ブックにて
 まず標準モジュールに

 '==============================================================
 Sub test()
    Dim r As Range
    Dim rr As Double
    With Range("B2:D2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Value = Array("", "男", "女")
    End With
    Set r = Range("c2")
    rr = Application.Min(r.Width, r.Height)
    rr = Sqr(rr ^ 2 + rr ^ 2)
    With ActiveSheet.Shapes.AddShape(msoShapeOval, r.Left + r.Width / 2 - rr / 2, r.Top + r.Height / 2 - rr / 2, rr, rr)
       .Fill.Transparency = 1#
       .Line.Visible = msoTrue
       .Name = "円"
       .Visible = False
    End With
 End Sub

 当該シートモジュールに

 '=========================================================================
 Option Explicit
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim rr As Double
    If Not Application.Intersect(Target, Range("b2")) Is Nothing Then
       With Range("b2")
          Shapes("円").Visible = False
          If .Value = "男" Then
             Set r = Range("c2")
          ElseIf .Value = "女" Then
             Set r = Range("d2")
          Else
             Set r = Nothing
          End If
          If Not r Is Nothing Then
             rr = Application.Min(r.Width, r.Height)
             rr = Sqr(rr ^ 2 + rr ^ 2)
             With ActiveSheet.Shapes("円")
                .Left = r.Left + r.Width / 2 - rr / 2
                .Top = r.Top + r.Height / 2 - rr / 2
                .Width = rr
                .Height = rr
                .Visible = True
             End With
          End If
       End With
    End If
 End Sub

 これでＢ２に男　女　を入れて試してみてください。

 >あと○をつけたあとオートシェイプを解除したいです。
 これは、意味がわかりません。

 ichinose@昨日、大型トラックから足滑らせて落下全身打撲（←ちょっと大げさ）

 こういうのもあります。↓　(#REF!MAN)
[[20040630171810]]『別のセルに図形を表示させる方法』（まっちやん）

ichinose 様
全身打撲の中回答ありがとうございます。お身体大丈夫でしょうか？
さきほど新規ブックにさっそく試してみましたが、実行時エラーで"指定した名前のアイテムが見つかりませんでした"というメッセージがでて止まってしまいました。
シートモジュールのデバックでは
Shapes("円"). Visible = False のところです。
(あ)

 >Shapes("円"). Visible = False のところです。
 あっ、急いでたので説明が抜けてました。

 新規ブックにて
 まず標準モジュールにある　testを実行してください。
 アクティブシートのＣ２，Ｄ２に男　女　と表示されます。

 その後、当該シートモジュールに

 Private Sub Worksheet_Change(ByVal Target As Range)
 で始まるプロシジャーをコピーしてください。

 これでＢ２に男　女　を入れて試してみてください。

 ichinose

これ使えます！
でも、丸ではなくて、楕円にしてほしいんですけど・・・

今更ながらのコメントですが、気付いてもらえるかな？！

 >丸ではなくて、楕円にしてほしいんですけど・・・
 まず、丸のコードを理解してください。
 丸は、WidthとHeightの値が等しいが、楕円が違いますよね！！
 この違いを修正すればよいのです。

 因みに選択したセル範囲に収まるような円又は、楕円を作成するコードは、

 Sub test1()
    Dim r As Range
    Set r = Selection
    With ActiveSheet.Shapes.AddShape(msoShapeOval, r.Left, r.Top, r.Width, r.Height)
        .Fill.Visible = msoTrue
        .Fill.Solid
        .Fill.ForeColor.SchemeColor = 65
        .Fill.Transparency = 1#
        .Line.Weight = 0.75
        .Line.DashStyle = msoLineSolid
        .Line.Style = msoLineSingle
        .Line.Transparency = 0#
        .Line.Visible = msoTrue
        .Line.ForeColor.SchemeColor = 64
        .Line.BackColor.RGB = RGB(255, 255, 255)
    End With
 End Sub

 円又は、楕円を作成したいセル範囲を選択した状態で上記のtest1を実行して見てください。

 このコードと既に投稿しているコードを調べて見てください。
 きちんと調べてもらえば、解決できると思います。

 ichinose

最近必要があって、エクセル関数で男女の別ごとに男女の文字に丸を付けるのに取り組んでみました。この最初の質問者さんが投稿されてから年数が経っていますが、他に必要になっている方もいるかと思い今更ながらですが、ここに掲載させていただきます。
私の場合、最初の回答者さんに近いのですが、更に補足とセルの書式設定で解決しました。
エクセル関数(=IF((参照するセルの番地)="男","Ⓜ︎"," 男 ",)で丸Mは、丸男(Zipcord 丸囲い文字/月の中に丸男丸女等ある)と Ⓜ︎の次にある " 男 "は、男の前と後ろに半角スペースを一つずつ入れてあります。イメージは、"◻︎男◻︎"です。
更に、関数を挿入するセルの書式を設定します。(縮小して全体を表示する)にチェックを入れます。それから、表示位置はセルの上下左右の中央に表示します。表示の確認をします。ここで大事な事は、丸男の表示と男の文字の表示のバランスです。丸男を表示させるセルの大きさとのバランスをとります。セルの大きさが固定されている場合もあります。
セルの文字サイズを大きくしてみたり、小さくしてみたりして男、女、空欄等試してみて、表示の確認をします。丸男の文字と男の文字が実際に大きのバランスが取れるところでサイズを決定します。
例として、通常フォントサイズ11くらいの場合、丸男の文字を14とか16で表示すると男の文字も12くらいに縮小されてバランスがとれています。セルの大きさは丸男の文字に合わせると合わせやすいと思います。

   スマホからの投稿のため丸男とかⓂ︎とか書きましたが、男の文字を◯で囲む表示のことです。
パソコンのMicrosoft Excelでエクセル関数でのIF関数を使用して自動表示する方法として掲載させていただきました。
既に解決済みである場合には、ご容赦くださるようお願いします。

（Mask. ） 2015/04/18(土) 17:02

すみません。上記の訂正です「Zipcord 丸囲い文字/月」ではなく、IMEパッドのUnicord（囲み CJK文字/月）U+3290の㊚、㊛でした。

追記として、例えば男、女の文字がセルが上下２段になっている場合です。参照のセルに男と入力した場合に、㊚と表示し女はそのままです。文字の大きさのバランスを変えないようにするために、" 男 "のように半角スペースを入れるところが重要なところです。参照セルの"男"と"㊚"には半角スペースは入れません。

それから、文字サイズを大きくするほど半角スペースが入っているので、逆にどんどん小さくなります。バランスのとれたところを根気良く見つけていきます。男、女のセルは、同じ大きさにすることが大事です。

エクセル関数(=IF(a1="男","㊚"," 男 ")
エクセル関数(=IF(a1="女","㊛"," 女 ")

また、一つのセルに表示する場合は、
エクセル関数(=IF(a1="男","㊚",IF(a1="女","㊛",""))としても良いかとおもいます。
男女以外は、空欄です。

再度記入しておくと、
「セルの書式設定」→「配置」→「縮小して全体を表示する」にチェックマークを入れる。

セルのフォントサイズを18など大きめにして、「㊚」と「男」とのバランスを見ながらサイズを決める。
セルの大きさとフォントサイズとの相互のバランス調整でなりたっています。

以上、先の投稿の訂正がてら追記しました。
（Mask Mask） 2015/04/18(土) 18:40

度々、すみません。Unicodeでした。
（Mask. ） 2015/04/18(土) 21:14

コメント返信：

[ 一覧(最新更新順) ]

[[20100326121043]] 『条件によって丸で囲む』（あ） ページの最後に飛ぶ

[[20100326121043]]　『条件によって丸で囲む』（あ）　ページの最後に飛ぶ