2022-05-02

簡潔に書こうとして失敗した

Excel VBA

こんなの書いた。範囲拡大するだけ。

Sub test1()
    
    Dim rng As Range
    Set rng = Range("A1")
    
    With rng
        Set rng = .Resize(, 2) '列数拡大(1→2)
        Set rng = .Resize(3) '行数拡大(1→3)
    End With
    
    Debug.Print rng.Address
    
End Sub

.Resize(, 2)で列数が2に変わったことは確認した。
しかし「$A$1:$A$3」が出力される。「$A$1:$B$3」じゃない。

With内で書き換えたから参照先がおかしくなった？
Resizeの行数を省略したから？

そもそも普通に書いても短く済むのに可読性悪くなってる。
結論。デバッグ重要。

以上。

2022-05-01

範囲を広げる（Offset、Resize）

Excel VBA

上下左右1セルずつ選択範囲を広げたい。
1セル選択→9セル選択、4セル選択→16(18)セル選択みたいな感じのことをしたい。

起点が1列目1行目の場合にOffsetでエラーが起きる。
これを無視すると簡単。

Sub 選択範囲を広げる1()
    
    On Error Resume Next
    
    Dim targetRange As Range
    
    With Selection
        Set targetRange = .Offset(-1, -1).Resize(.Rows.Count + 2, .Columns.Count + 2)
    End With
    
    targetRange.Select
    
End Sub

上記Offset時のエラー回避版。

Sub 選択範囲を広げる2()
    
    Dim targetRange As Range
    Set targetRange = Selection '.Areas(1)
    
    Dim iRowAdd As Integer: iRowAdd = 1
    Dim iColumnAdd As Integer: iColumnAdd = 1
    
    If targetRange(1).Row > 1 Then
        Set targetRange = targetRange.Offset(-1, 0)
        iRowAdd = 2
    End If
    If targetRange(1).Column > 1 Then
        Set targetRange = targetRange.Offset(0, -1)
        iColumnAdd = 2
    End If
    
    With targetRange
        Set targetRange = .Resize(.Rows.Count + iRowAdd, .Columns.Count + iColumnAdd)
    End With
    
    targetRange.Select
    
End Sub

以上。

2022-04-30

罫線を引く、消す、有無を比較

Excel VBA

罫線について使うプログラムと定数をまとめた。

'選択範囲に格子の線を引く
Selection.Borders.LineStyle = xlContinuous ’実線
Selection.Borders.LineStyle = True '同じ結果

' 選択範囲に中太、青色、格子線
' 線の指定をせずとも罫線が出る不思議。
With Selection.Borders
    .Weight = xlMedium '中
    .Color = vbBlue '青色
End With

'下辺に実線
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous

'選択範囲の外周に線を引く
Selection.BorderAround LineStyle:=xlContinuous ', Weight:=xlThick, Color:=vbRed

'選択範囲の罫線を消す。以下全部同じ結果。
Selection.Borders.LineStyle = xlLineStyleNone
Selection.Borders.LineStyle = xlNone
Selection.Borders.LineStyle = False

罫線の有無が混在する複数セルに対して実施するとNullが返るため、比較は慎重に行う。

' A1について下線の有無を比較
If Range("A1").Borders(xlEdgeBottom).LineStyle = xlLineStyleNone Then
    Debug.Print "罫線無い"
Else
    Debug.Print "罫線ある！"
End If

'選択範囲の罫線が格子であるか比較
With Selection.Borders
    If IsNull(.LineStyle) Then
        Debug.Print "罫線が混在"
    Else
        If .LineStyle = xlLineStyleNone Then
            Debug.Print "罫線無い"
        Else
            Debug.Print "罫線ある！"
        End If
    End If
End With

線の種類

定数	内容	値
xlContinuous	実線（細）	1
xlDash	破線	-4115
xlDashDot	一点鎖線	4
xlDashDotDot	二点鎖線	5
xlDot	点線	-4118
xlDouble	二重線	-4119
xlSlantDashDot	斜め斜線	13
xlLineStyleNone	無し	-4142

線の太さ

定数	内容	値
xlHairline	極細線	1
xlThin	細線	2
xlMedium	中太線	-4138
xlThick	太線	4

線の場所。未指定で格子。

定数	内容	値
xlDiagonalDown	右下がり斜め線	5
xlDiagonalUp	右上がり斜め線	6
xlEdgeLeft	左辺	7
xlEdgeTop	上辺	8
xlEdgeBottom	下辺	9
xlEdgeRight	右辺	10
xlInsideVertical	内側の垂直線	11
xlInsideHorizontal	内側の水平線	12

以上。

2022-04-29

プロシージャが大きすぎます

Excel VBA

プログラムが大きいとエラー。64Kを超えるとダメとのこと。

8,000行くらい書いて実行したら上記のエラーが出ました。

Sub test()
    
    Dim iYear As Integer, iMonth As Integer, iDay As Integer
    Dim sMsg As String
    
    'テストデータ
    iYear = 2023
    iMonth = 2
    iDay = 30
    
    If iYear = 2022 And iMonth = 1 And iDay = 1 Then
        sMsg = "2022年1月1日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 2 Then
        sMsg = "2022年1月2日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 3 Then
        sMsg = "2022年1月3日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 4 Then
        sMsg = "2022年1月4日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 5 Then
        sMsg = "2022年1月5日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 6 Then
        sMsg = "2022年1月6日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 7 Then
        sMsg = "2022年1月7日"
    ElseIf iYear = 2022 And iMonth = 1 And iDay = 8 Then
        sMsg = "2022年1月8日"
    
    '～略～
    
    ElseIf iYear = 2032 And iMonth = 12 And iDay = 30 Then
        sMsg = "2032年12月30日"
    ElseIf iYear = 2032 And iMonth = 12 And iDay = 31 Then
        sMsg = "2032年12月31日"
    Else
        sMsg = "日付が不正です"
    End If
    
    Debug.Print sMsg
    
End Sub

コンパイルエラーが起きなくなるまでIF文の分岐を下から削除。
このラインでエラーが出なくなり、約3,500行残った。削除せずにコメントアウトでもOK。

ダメなポイント
・3,500行も書いて日付範囲が5年弱。
・別プロシージャを追加すれば日付範囲が広げられる？
・プロシージャの64K制限をどうにかすれば・・・
・改修の作業量が尋常じゃない。
・違う。そうじゃない。

上記プログラムを出力したプログラムも載せときます。

'新規シートに出力される。VBEにコピペしてインデント揃える。
Sub プログラムを出力するプログラム()
    
    Dim iYear As Integer, iMonth As Integer, iDay As Integer
    Dim sMsg As String
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets.Add
    
    Dim iRow As Long: iRow = 1
    
    For iYear = Year(Now()) To Year(Now()) + 10
        For iMonth = 1 To 12
            For iDay = 1 To 31
                
                '月またぎ判定。うるう年対応。
                If Not IsDate(iYear & "/" & iMonth & "/" & iDay) Then Exit For
                
                sh.Range("A" & iRow).Value = "elseif iYear = " & iYear & " and iMonth = " & iMonth & " and iDay = " & iDay & " then"
                sh.Range("B" & iRow + 1).Value = "sMsg = """ & iYear & "年" & iMonth & "月" & iDay & "日"""
                
                iRow = iRow + 2
                
            Next
        Next
    Next
    sh.Range("A" & iRow).Value = "end if"
    sh.Range("A1").Value = Replace(sh.Range("A1").Value, "elseif", "if") '最初のelseifを修正
    
    Set sh = Nothing
    
End Sub

以上。

2022-04-28

CSSで行間調整

HTML

<p class="div-sample" style="line-height: 100%;">

.div-sample {
    width: 270px;
    margin-right: auto;
    background-color: #FFFFCC;
}

line-height
行間調整用プロパティ。文字サイズ+行間の数値を指定する。
推奨値1.5以上。1.5と150%は同じ指定。px、emでも指定可能。
指定サイズ-文字サイズで余った分が上下均等に割り振られる。

以下、どんな感じになるのかテスト。

未指定