[[20080124134152]] 『文字を簡単に丸で囲む方法』(ななこ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『文字を簡単に丸で囲む方法』(ななこ)

 こんにちは。
 各セルの文字を任意で囲みたいと思います。
 過去ログから以下のコードをお借りしているのですが、
 この円を常にセルの中央に表示することはできるでしょうか。

 ----------------------

 rivate Sub Worksheet_SelectionChange(ByVal Target As Range)

 Dim sp As Integer, i As Integer
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("B5:M6")) Is Nothing Then Exit Sub
    With Target
            For i = 1 To Me.Shapes.Count
            If Left(Shapes(i).Name, 4) = "Oval" Then
                If Me.Shapes(i).TopLeftCell.Address = .Address Then: sp = i
            End If
        Next i
        If sp Then
            Shapes(sp).Delete
    Else
        Select Case .Address(0, 0)
          Case "B5", "C5", "F5", "G5", "H5", "B6", "F6"
            Me.Shapes.AddShape  (msoShapeOval, .Left, .Top, .Height, .Height).Fill.Visible = msoFalse
          Case "J5", "K5", "L5", "M5"
            Me.Shapes.AddShape(msoShapeOval, .Left, .Top, .Height + 20, .Height).Fill.Visible = msoFalse
        End Select
    End If
    End With
End Sub


 参考になると思います。 (1or8)
[[20071114041820]]『土曜日を□、日・祝日を○で囲みたい』

 1or8様、ありがとうございました。
 思いどおりの形にすることができました。
 心より感謝申し上げます。

 (ななこ)

 下記マクロで,アクティブセルに丸(正確にはセル形状に応じた楕円)を書きます。
   セルを選んでからマクロを
  実行してみてください。(夕焼)

Sub maru()

 hi = 1.5 ' 楕円高さのセル高さ倍率1.5位,適宜変更可能
 awide = ActiveCell.Width
 aheight = ActiveCell.Height
 aleft = ActiveCell.Left
 atop = ActiveCell.Top - aheight * (hi - 1) * 0.5

 ActiveSheet.Shapes.AddShape(msoShapeOval, aleft, atop, awide, aheight * hi).Select
 Selection.ShapeRange.Fill.Visible = msoFalse
 End Sub

  過去の掲示板からですが

 下記もあります。右クリックで囲みます。(夕焼)
 色々な形状を選択できますので好きな形状を生かしてください。(注記マークを解除)

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

 hi = 1.5 ' 楕円高さのセル高さ倍率1.5位,適宜変更可能
 awide = ActiveCell.Width
 aheight = ActiveCell.Height
 aleft = ActiveCell.Left
 atop = ActiveCell.Top - aheight * (hi - 1) * 0.5

 'ActiveSheet.Shapes.AddShape(msoShapeHexagon, aleft, atop, awide, aheight * hi).Select
 'ActiveSheet.Shapes.AddShape(msoShapeCan, aleft, atop, awide, aheight * hi).Select
 'ActiveSheet.Shapes.AddShape(msoShapeArc, aleft, atop, awide, aheight * hi).Select
 'ActiveSheet.Shapes.AddShape(msoShapeDiamond, aleft, atop, awide, aheight * hi).Select
 'ActiveSheet.Shapes.AddShape(msoShapeFoldedCorner, aleft, atop, awide, aheight * hi).Select
 'ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, aleft, atop, awide, aheight * hi).Select
 ActiveSheet.Shapes.AddShape(msoShapeOval, aleft, atop, awide, aheight * hi).Select
 Selection.ShapeRange.Fill.Visible = msoFalse
 ActiveCell.Select
 End Sub


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.