虫食い

今回もプライバシーシートと同様に
乱数を使ってセルの塗りつぶしを設定していきます。

虫食いとは何？ということですが、
いちばん最初にあるセルを選択しているとします。
次に
そこから上、下、右、左のセルのどれかに
移動します。
この４つの方向を決めるのに乱数を使います。
あとはそれの繰り返しです。

1行目のどこかのセルでさらに上に進もうとすると
エラーになります。
このような状況のエラーを防ぐために、
上端と下端の行、左端と右端の列ではないかの
判定をIf文でしています。

コードはこちら

Sub macro110731a()
'虫食い

    Sheets.Add
   
    Dim i As Long
    Dim MyRange As Range
    Dim r As Range
    Set r = Selection
   
    'セルの大きさ変更
    Cells.RowHeight = 3
    Cells.ColumnWidth = 2 * (6.88 / 45)
   
    For i = 0 To 200000
        r.Select
        Select Case Int(Rnd * 4)
            Case 0
                If r.Row + 1 < Rows.Count Then
                    r.Offset(1, 0).Interior.ColorIndex = 1
                    Set r = r.Offset(1, 0)
                End If
            Case 1
                If r.Column + 1 < Columns.Count Then
                    r.Offset(0, 1).Interior.ColorIndex = 1
                    Set r = r.Offset(0, 1)
                End If
            Case 2
                If r.Row - 1 > 0 Then
                    r.Offset(-1, 0).Interior.ColorIndex = 1
                    Set r = r.Offset(-1, 0)
                End If
            Case 3
                If r.Column - 1 > 0 Then
                    r.Offset(0, -1).Interior.ColorIndex = 1
                    Set r = r.Offset(0, -1)
                End If
        End Select
    Next i
   
End Sub

実行後のシートの一例：

これはシートを25%で表示した画像です。

こういうのも何回やっても
飽きないです。

プライバシーシート2

数字を使ったプライバシーシートは
たくさんShapeを使ったため重かったです。

もっと実用的に、
ランダムな模様で
プライバシーシートを作ってみます。

白黒のモザイクのような模様を
セルの塗りつぶしで作ります。
セルの大きさを小さな正方形状にしてから
そのセルに乱数で白か黒かを決定して、
塗りつぶしをしていきます。

下のコードのMyRangeにテキトーな範囲が入れてありますので、
コード実行後に用紙や余白を調整して
印刷してください。

For Eachステートメント内のIf文の条件

Rnd > 0.5

は半分くらいの割合で白と黒に塗りつぶしが設定されます。

これを「Rnd > 0.3」にすればより黒が多くなり、
「Rnd > 0.7」にすればより白が多くなります。

コードはこちら

Sub macro110730a()
'プライバシーシート2

    Sheets.Add
    Dim MyRange As Range
    Dim r As Range
   
    'セルの大きさ変更
    Cells.RowHeight = 3
    Cells.ColumnWidth = 2 * (6.88 / 45)
   
    Set MyRange = Range("A1:IV500")
    For Each r In MyRange
        If Rnd > 0.5 Then
            r.Interior.ColorIndex = 1
        End If
    Next r
   
End Sub

実行後はこのようになります。

これをA4の用紙に印刷してみました。

いや～
ずっと眺められますね、これ。

もっと厚手の色画用紙に
黒ではなく濃いグレーくらいの色で印刷すれば
裏から透けなくなります。
封筒にも使えると思います。

プライバシーシート

役所などからの封筒や各種請求書の封筒の内側には
ランダムな模様や文字が印刷されています。
それによって中身が見えないようになっています。

ちょっと前に下の画像のようなシートが貼られた
ハガキがきました。

ランダムな模様や文字ではなく数字でした。
面白い模様だなっと思ったので
これをExcelで作ってみます。

コードはこちら

Sub macro110724a()
'プライバシーシート

    Sheets.Add
    Cells.Interior.ColorIndex = 2
   
    Dim i As Integer, j As Integer
    Dim MyRange As Range
    Dim r As Range
    Dim tb As Object
    Dim d As Integer
    Dim num1 As Integer, num2 As Integer
    d = 12 '文字の大きさpt
   
    'セルの大きさ変更
    Cells.ColumnWidth = 8
    Cells.RowHeight = 30

    'ランダムな数字の行数
    num1 = Int(Cells(1, 1).Height / (d / 2)) - 1
    'ランダムな数字の横の文字数
    num2 = Int(Cells(1, 1).Width / (d / 2)) - 2
   
    Set MyRange = Range("A1:C3")
    For Each r In MyRange
        For i = 0 To num1  '行
            For j = 0 To num2 - 1 '列
                'テキストボックス作成
                Set tb = ActiveSheet.Shapes.AddTextbox( _
                    msoTextOrientationHorizontal, _
                    r.Left + j * (r.Width / num2) + d * Sgn(0.5 - Rnd) * Int(Rnd * 20) / 100, _
                    r.Top + i * (r.Height / 2 / num1) + d * Sgn(0.5 - Rnd) * Int(Rnd * 20) / 100, _
                    100, 100).DrawingObject
                        
                'ボックス内の文字列
                tb.Characters.Text = Int(Rnd * 10)
               
                'ここから
                'フォント
                With tb.Characters.Font
                    .Name = "ＭＳ Ｐゴシック" 'フォント名
                    .FontStyle = "太字" 'スタイル
                        '標準/斜体/太字/太字 斜体(フォントで異なる場合も)
                    .Size = d 'サイズ
                    .ColorIndex = 0 '色
                End With
               
                '配置
                With tb
                    .HorizontalAlignment = xlLeft '文字の配置-横位置
                        'xlLeft/xlCenter/xlRight/xlJustify/xlDistributed
                    .VerticalAlignment = xlTop '文字の配置-縦位置
                        'xlTop/xlCenter/xlBottom/xlJustify/xlDistributed
                    Select Case Int(Rnd * 3)
                        Case 0
                            .Orientation = xlHorizontal '方向
                        Case 1
                            .Orientation = xlVertical '方向
                        Case 2
                            .Orientation = xlUpward '方向
                        Case 3
                            .Orientation = xlDownward '方向
                    End Select
                    .AutoSize = True '自動サイズ調整
                End With
                '色と線-塗りつぶし
                With tb.ShapeRange.Fill
                    .Visible = msoFalse '色-ありなし
                End With
   
                '色と線-線
                With tb.ShapeRange.Line
                    .Visible = msoFalse '色-ありなし
                End With
   
                'ここまで
            Next j
        Next i
    Next r
   
End Sub

変数dとセルの高さと幅、
AddTextboxメソッドのLeft、Top引数の数式、
を変更すると数字の出方が変わります。

変数MyRangeで範囲をして指定ます。
ここを広範囲にすると
フリーズすることがあるかもしれません。
保存してから実行してください。

実行後はこのようになります。

ちょっと違いますかね？

市販のA4が入る封筒は紙が薄いので、
確定申告のとき中身がスケスケで
さすがにこれでは嫌だなと思った経験があります。

これをA4サイズで作成して印刷すれば、
確定申告のときなど
書類と一緒に封筒にいれるとある程度透けないと思います。

指数形式 E の意味

指数形式 E を知らないと、
セルの値にEの文字が出てくると
値がどんな大きさなのかさっぱりわかりません。

E の意味ですが、

小数点の移動桁数に対応する数値が E 記号の右側に表示される

ということです。
参:Excel の [セルの書式設定] ダイアログ ボックスの設定を制御および理解する方法

例えば、

0.000 000 000 1 = 1E-10
0.000 000 000 2 = 2E-10
2 000 000 000 = 2E+9

1つ目は、小数点を右に10持っていくと1になります。
「E-10」は、「小数点を右に10持っていく」ということです。
2つ目も同様の考え方。

3つ目は小数点を左に9持っていくと2になります。
「E+9」は、「小数点を左に9持っていく」ということです。

型宣言文字とその使用方法

データ型について型宣言文字についてです。

型宣言文字とは、
変数、定数、関数名の末尾に付ける、データ型を示す文字です。

次の表のようになっています。

データ型	型宣言文字
整数型 (Integer)	パーセント記号 (%)
長整数型 (Long)	アンパサンド (&)
単精度浮動小数点数型 (Single)	エクスクラメーションマーク (!)
倍精度浮動小数点数型 (Double)	シャープ記号 (#)
文字列型 (String)	ドル記号 ($)

1に型宣言文字をつけてデータ型を調べるのを、
イミディエイトで実行すると次のようになります。

次は、変数に型宣言文字をつけます。
それぞれ「As ～」をつけなくても
型宣言文字で指定したデータ型になります。

Dim i% 'Integer型
Dim l& 'Long型
Dim s! 'Single型
Dim d# 'Double型
Dim str$ 'String型

「関数名の末尾に付ける」については
うまくできませんでした。

末尾ってどこでしょう？
一応自作関数を作って
そのFunctionプロシージャの末尾らしきところに$を付加したり、
自作関数を使うときに$を付加したりしましたが
エラーになってできませんでした。

型宣言文字を使ってデータ型を宣言すれば入力は楽ですが、
今までのやり方を変えるのは少し勇気がいりますね。
あとからコードを見たとき
わかりやすいか気になります。

テキストボックスを作成する2

記事『 テキストボックスを作成する 』のつづき、
テキストボックスの設定を詳しく見ていきます。

まずはテキストボックスには
どんな設定ができるのかを調べます。

テキストボックスの枠のところで右クリックして、

テキストボックスの書式設定を見ます。

以下タブの名前と設定できるものを列挙します。

フォント
    フォント名
    スタイル
    サイズ
    文字飾り-取り消し線
    文字飾り-上付き
    文字飾り-下付き
    下線
    色
    標準フォント

配置
    文字の配置-横位置
    文字の配置-縦位置
    方向
    自動サイズ調整

色と線
    塗りつぶし-色
    塗りつぶし-半透明にする
    線-色
    線-スタイル
    線-実線/点線
    線-太さ

サイズ
    サイズと角度-高さ
    サイズと角度-幅
    倍率-縦横比を固定する

保護
    ロック
    文字列のロック

プロパティ
    セルに合わせて移動やサイズ変更
    (移動やサイズ変更する/移動するがサイズ変更はしない/変更はしない)
    オブジェクトを印刷する

余白
    左
    上
    右
    下

Web
    代わりに表示する文字列

タブごとにみていきます。
以下はタブごとに設定できるものを
Withステートメントでまとめてあるコードです。

必要なWithブロックを
テキストボックス作成の「基本のコード」の中、
ここから、ここまでの間にコピペしてください、
またWithブロックの中で不必要なものは消してください。

「基本のコード」の中のAddTextboxメソッドの引数や
ボックス内の文字列は適宜変更してください。
基本のコードはこちら

Sub macro110716a()
'テキストボックス作成「基本のコード」
'オブジェクト変数を使 用

    Dim tb As Object
   
    'テキストボックス作成
    Set tb = ActiveSheet.Shapes.AddTextbox( _
        msoTextOrientationHorizontal, _
        50, 50, _
        200, 120).DrawingObject
            
    ' ボックス内の文字列
    tb.Characters.Text = "abc" & Chr(10) & "def"
   
    'ここから
   
   
    'ここまで
End Sub

フォント

    'フォント
    With tb.Characters.Font
        .Name = "ＭＳ Ｐゴシック" 'フォント名
        .FontStyle = "標準" 'スタイル
            '標準/斜体/太字/太字 斜体(フォントで異なる場合も)
        .Size = 11 'サイズ
        .Strikethrough = False '文字 飾り-取り消し線
        .Superscript = False '文字飾り-上付き
        .Subscript = False '文字飾り-下付き
        .Underline = xlUnderlineStyleNone '下線
        .ColorIndex = xlAutomatic '色
        '標準フォントにするときは これらを設定しない
    End With

配置

    '配置
    With tb
        .HorizontalAlignment = xlLeft '文字の配置-横位置
            'xlLeft/xlCenter/xlRight/xlJustify/xlDistributed
        .VerticalAlignment = xlTop '文字の配置-縦位置
            'xlTop/xlCenter/xlBottom/xlJustify/xlDistributed
        .Orientation = xlHorizontal '方向
            'xlHorizontal/xlVertical/xlUpward/xlDownward
        .AutoSize = True '自動サイズ調整
    End With

色と線

    '色と線-塗りつぶし
    With tb.ShapeRange.Fill
        .Visible = msoTrue '色-ありなし
            'msoTrue/msoFalse
        .ForeColor.SchemeColor = 40 '色
        .Transparency = 0.8 '半透明にする
            '0から1まで、1=透明
    End With
   
    '色と線-線
    With tb.ShapeRange.Line
        .Visible = msoTrue '色-ありなし
        .ForeColor.SchemeColor = 53 '色
        .Weight = 1.5 '太さ
        .DashStyle = msoLineSolid '実線/点線
            'msoLineSolid/msoLineRoundDot/msoLineSquareDot/msoLineDash
            'msoLineDashDot/msoLineLongDash/msoLineLongDashDo/msoLineDashDotDot
        .Style = msoLineSingle 'スタイル
            'msoLineThinThin/msoLineThinThick
            'msoLineThickThin/msoLineThickBetweenThin
    End With

サイズ

    'サイズ
    With tb.ShapeRange
        .LockAspectRatio = msoTrue '倍率-縦横比を固定する
        .Height = 86.25 'サイズと角度-高さ
        .Width = 119.25 'サイズと角度-幅
    End With

保護

    '保護
    With tb
        .Locked = True 'ロック
        .LockedText = True '文字列のロック
    End With

プロパティ

    'プロパティ
    With tb
        .Placement = xlMoveAndSize 'セルに合わせて移動やサイズ変更
            'xlMoveAndSize/xlMove/xlFreeFloating
        .PrintObject = True 'オブジェクトを印刷する
    End With

余白

    '余白
    With tb.ShapeRange.TextFrame
        .MarginLeft = 7.09 '左
        .MarginRight = 7.09 '右
        .MarginTop = 3.69 '上
        .MarginBottom = 3.69 '下
    End With

Web

    'Web
    tb.ShapeRange.AlternativeText = "abc" & Chr(10) & "def"

テキストボックスを作成する

セルに関係なく文字を表示したいときは
ワードアートを使うしかないと思っていましたが、
テキストボックスというものがあるのですね。
下の画像は[図形描画]ルーツボックスですが、
テキストボックスは矢印のマークです。

これ、横組みか縦組みかを選択するだけのボタンだと思ってました。
横組みのテキストボックスか、
縦組みかのテキストボックスを選択するボタンでした。

文字をVBAで作成して遊びたいと考えていて、
その為にShapeについて調べています。
今回はテキストボックスを作成、変更などについて
やっていきます。

まずはテキトーにテキストボックスを作成して、
マクロ自動記録します。

自動記録を少し加工したコードはこちら

Sub macro110710a()
'テキストボックス作成
'マクロ自動記録から

    'テキストボックス作成
    ActiveSheet.Shapes.AddTextbox( _
        msoTextOrientationHorizontal, _
        369#, 99.75, _
        176.25, 111# _
        ).Select
       
    'ボックス内の文字列
    Selection.Characters.Text = "abc" & Chr(10) & "def"
   
    '文字装飾
    With Selection.Characters.Font
        .Name = "ＭＳ Ｐゴシック "
        .FontStyle = "標準"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
   
End Sub

テキストボックスの作成には
AddTextboxメソッドを使います。

AddTextboxメソッドの引数は順番に次のようになっています。

ラベル内のテキストの向き
左端からの位置
上端からの位置
幅
高さ

テキストボックスを作成するとき
後で設定を変更する予定があるのか、ないのかで方法が違うと思います。

変更する予定がある場合は名前をつけたほうが
後々便利だと思います。

変更する予定がない場合は名前をつけるのが手間ですので、
作成したテキストボックスを
SelectしてSelectionをWithステートメントで使うか(上のコード)、
オブジェクト変数に入れてその変数を使います。

次のコードはNameプロパティを使う方法と
オブジェクト変数を使う方法です。

Sub macro110710b()
'テキストボックス作成
'Nameを使用

    Dim tbName As String
    tbName = "テキスト" '名前
   
    'テキストボックス作成
    ActiveSheet.Shapes.AddTextbox( _
        msoTextOrientationHorizontal, _
        369#, 99.75, _
        176.25, 111# _
        ).Name = tbName
       
    'ボックス内の文字列
    ActiveSheet.Shapes(tbName).DrawingObject. _
        Characters.Text = "abc" & Chr(10) & "def"
   
    '文字装飾
    With ActiveSheet.Shapes (tbName).DrawingObject. _
        Characters.Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "標準"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
   
End Sub

Sub macro110710c()
'テキストボックス作成
'オブジェクト変数を使用

    Dim tb As Object
   
    'テキストボックス作成
    Set tb = ActiveSheet.Shapes.AddTextbox( _
        msoTextOrientationHorizontal, _
        369#, 99.75, _
        176.25, 111#).DrawingObject
            
    ' ボックス内の文字列
    tb.Characters.Text = "abc" & Chr(10) & "def"
   
    '文字装飾
    With tb.Characters.Font
        .Name = "ＭＳ Ｐゴシック "
        .FontStyle = "標準"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
   
End Sub

文字の装飾のコードの部分は
読んでそのままです。

AddTextboxメソッドの引数で左端からの位置と高さの値、
#が最後についています。
マクロ自動記録したものですので確信はありませんが、
これは型宣言文字だと思います。

型宣言文字は、
数値の最後につけるとデータ型を宣言できるというものです。

しかしAddTextboxメソッドのこの引数はSingle型で、
#はDouble型の型宣言文字です。
Single型の型宣言文字は、! なんですが、
この型の不一致についてはいまいちわかりません。

この#を消して上のコード3つを実行してもエラーにはならないので、
自分で数値を指定する場合も
まあ気にしなくても問題ないと思います。

樹を写生するときは大枝から描くように…
小枝はあとまわしです。

秒の小数部分の表示形式

1秒の小数点第二位までExcelのセルで表示できるようです。

表示形式が「h:mm:ss.00」だと
12:28:34.78などと表示されます。
1/100秒単位で表示ということになります。
ストップウォッチと同じです。

セルに手動で「=NOW()」と入力して
表示形式を「h:mm:ss.00」にすれば1/100秒まで表示されます。

VBAで次のようにすると
秒の小数点以下は常に「.00」です。

Cells(1, 1) = Now
Cells(1, 1).NumberFormatLocal = "hh:mm:ss.00"

Time関数でも同様です。
これらの関数は秒の小数点以下は返しません。

Timer関数だけが秒の小数点以下も返します。
次のコードは現在の時刻を1/100秒まで表示します。

Cells(1, 1) = Timer / 24 / 60 / 60
Cells(1, 1).NumberFormatLocal = "hh:mm:ss.00"

日付も付加した現在の時刻を1/100秒まで表示します。

Cells(1, 1) = CDbl(Date) + (Timer / 24 / 60 / 60)
Cells(1, 1).NumberFormatLocal = "yyyy/mm/dd hh:mm:ss.00"

CDbl関数でDate関数が返す値をDouble型に変換しないと
うまくいかないので注意してください。

フォント名一覧とその見本を作成

書式設定のツールバーで
使えるフォントがわかります。

ということは、
このツールバーを探っていけば
使えるフォントがわかるということですね。

マクロ自動記録を開始して
書式設定のツールバーのフォント名を変えたりします。
すると記録されたコードで
このツールバーのオブジェクトが

Application.CommandBars("Formatting")

であることがわかります。
あとはこれをウォッチウィンドウにいれて見れば
いろいろとわかります。

上の画像のフォント名が表示されているところは、

Application.CommandBars("Formatting").Controls.Item(1)
(以下これを～で表す。）

となります。
ちなみにフォントサイズのところはItem(2)です。
お目当てのプロパティはこのようになります。

～.ListCount = フォントの総数
～.List(i) = フォントの名前
～.ListIndex = フォントのIndex

これらを踏まえて
フォント名一覧とその見本を作成します

コードはこちら

Sub macro110702a()
'フォント名と見本一覧を作成

    Sheets.Add
    Cells(1, 1) = "フォント名"
    Cells(1, 2) = "見本"
   
    Dim i As Integer
    Dim str As String
    Dim obj As Object
    str = "やむえむのExcel VBAメモ"
    Set obj = Application.CommandBars("Formatting"). _
        Controls.Item(1)
   
    For i = 1 To obj.ListCount
        Cells(i + 1, 1) = obj.List(i)
        Cells(i + 1, 2) = str
        Cells(i + 1, 2).Font.Name = obj.List(i)
    Next i
   
End Sub

実行後のシートの一部：

A列がフォントの名前、
B列がその行のA列のフォントの見本です。

これでいちいち手動で確かめる必要がなくなりました。
バンザイVBA