[[20200217144536]] 『マクロを使って土日祝日はオートシェープでカレン』(桃丸) ページの最後に飛ぶ

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

 

『マクロを使って土日祝日はオートシェープでカレンダーに楕円を付けたいです。』(桃丸)

縦書きのカレンダーに日付と曜日があります。
その上を楕円で囲みたいのですがどうやったらいいですか?
VBA初心者です。

< 使用 Excel:Excel2013、使用 OS:Windows8 >


どういうレイアウトのカレンダなのか判らないと、教えようがないです。日付と曜日で1セルになっていて、A列1行目から縦に並んでいるとか、日曜を先頭とした曜日毎になっていて6行あるとか。 具体的なセルのアドレスと、セルにはシリアル値でセットしているのか、ただの数字なのか等。

それよりも、ご自分でマクロを書けないくらいなら、マクロで円図形を置くより、条件付き書式でセルの背景色を塗りつぶしてはどうでしょう? 図形を重ねると数字を隠して見辛くなるので、塗りつぶしの方が良いように思うのですが。
(???) 2020/02/17(月) 15:07


お返事ありがとうございます。
条件付き書式設定はしてあるのですが、うちのプリンタがカラーは印刷できず…
条件設定しても何もつかない状態です。
柄を付けても白くしかでないので、いつもオートシェープで作ってます。
Aのセルが日にちBのセルが曜日です。
(桃丸) 2020/02/18(火) 09:13

 網掛けとかにしてみては?
(コナミ) 2020/02/18(火) 09:43

 こんにちは
 該当セルを選択する方法ですが。

 Sub 楕円作成()

  Dim 楕円 As Range
  Set 楕円 = ActiveCell
    With ActiveSheet.Shapes.AddShape(msoShapeOval, _
     楕円.Left + 2, 楕円.Top + 2, 55, 22) '55横、22縦 セルに合わして下さい。
     .Fill.Visible = msoFalse
     .Line.Weight = 1
    End With
 End Sub
(思い込み) 2020/02/18(火) 09:49

白黒印刷しかできなかった頃にできたのが網掛けという方法ですよねぇ。 私もそっちが定番と思います。 自分でできない事を人に頼むより、自分でできる方法で解決すべき。

とりあえず、2列で縦方向だけに日付と曜日が並んでいるようなので、以下とか。

 Sub test()
    Dim S As Shape
    Dim i As Long

    For Each S In ActiveSheet.Shapes
        If S.Name Like "丸*" Then
            S.Delete
        End If
    Next S

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Select Case Cells(i, "B").Text
        Case "土", "日"
            With Range(Cells(i, "A"), Cells(i, "B"))
                With ActiveSheet.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height)
                    .Name = "丸" & i
                    .Fill.Visible = msoFalse
                    .Line.Weight = 1.5
                    .Line.ForeColor.RGB = RGB(255, 0, 0)
                End With
            End With
        End Select
    Next i
 End Sub
(???) 2020/02/18(火) 10:16

ちなみに、土日だけ丸をつけましたが、祝日をどう表現しているのか判らないので、そこはご自身で処理追加してみてくださいね。(B列が"祝"になっているとか)
(???) 2020/02/18(火) 10:20

 >条件付き書式設定はしてあるのですが、うちのプリンタがカラーは印刷できず… 
 >条件設定しても何もつかない状態です。

条件付き書式で既に土日、祝日には着色(背景)されていると判断しました。
B列(Columns(2))の白色以外のセルに楕円を描きます。
Sub Test()

    Dim myArea As Range
    Dim c As Range
    'シート上の全楕円を削除
    ActiveSheet.Ovals.Delete
    'B列の定数が含まれている範囲を取得
    Set myArea = ActiveSheet.Columns(2).SpecialCells(xlCellTypeConstants)
    For Each c In myArea
        '白色以外のセル判別
        If c.DisplayFormat.Interior.Color <> vbWhite Then
            With ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height)
                .Fill.Visible = msoFalse                    '塗りつぶしなし
                .Line.ForeColor.RGB = RGB(0, 0, 0)          '線色を黒
                .Line.Weight = 1                            '線の太さ1
            End With
        End If
    Next
End Sub

(ピンク) 2020/02/18(火) 11:50


コナミさん 有難う御座います。網掛けはしましたが印刷には反映しませんでした。

思い込みさん有難う御座います。やってみましたが、楕円が1つ出ただけでした。

???さんのものでやってみました。土日に楕円が付きました。ありがとうございます。

ピンクさんのものでも出来ました。ありがとうございます。
(桃丸) 2020/02/18(火) 13:41


 >網掛けはしましたが印刷には反映しませんでした

 印刷時にページ設定のシートタブで白黒印刷にチェックとか入れてませんか?
 モノクロ印刷しかできないプリンターでも網掛けが印刷できないとかは
 ないと思いますよ。
(コナミ) 2020/02/18(火) 13:44

 >条件設定しても何もつかない状態です。

 最初の方でこう書いてるし、実は白黒印刷にチェックが入ってましたというオチ!?

(コナミ) 2020/02/18(火) 13:50


コナミさん
カラーでやっても出ません。
どういう設定なのか分かりませんが、オートシェープでやるのが一番いいかと思われます。
(桃丸) 2020/02/18(火) 14:28

 >カラーでやっても出ません。

 ということはプリンターはカラーも印刷できて、そのExcelがカラーで出ないという事ですよね。
 (話がちょっと違ってきてるけど)
 別に原因を調べたりするつもりがないならそれでいいんですが、回答されたことは全て試しても
 無駄にはならないと思いますよ。

 【再掲】
  印刷時にページ設定のシートタブで白黒印刷にチェックとか入れてませんか?
 追加で、

 ページレイアウトタブのページ設定の文字の横の□を押してシートタブの
 □白黒印刷
 にチェックがないか見てみてください。
(コナミ) 2020/02/18(火) 14:39

インクジェットプリンタによくあるのが、目的の色インクが固まっていて噴出されていない、とか。 テスト印刷してみれば判るでしょう。(網掛けが出ないのも、黒インク以外を混ぜて灰色を作っているせい、とか?)

まぁ、深追いせずとも、円図形で問題ないなら構いませんが。
(赤丸にしたけど印刷されているなら、灰色は出ているわけで、網掛けも出そうですけどね)
(???) 2020/02/18(火) 14:45


コメント返信:

[ 一覧(最新更新順) ]


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