MW211 EXIT

devlog
ExcelVBA/QRコード作成
2020年05月14日
【必要なもの】
  Excel2013以降とAccessRuntime2013以降
  両者のbit数は同じでなければならない
  →ActiveXコントロールに「Microsoft BarCode Control 15.0」が表示されればOK

【AccessRuntimeの入手先】
  Microsoft Access 2013 Runtime
    https://www.microsoft.com/ja-jp/download/details.aspx?id=39358
  Microsoft Access 2016 Runtime
    https://www.microsoft.com/ja-jp/download/details.aspx?id=50040

【追加方法】
  「Microsoft BarCode Control 15.0」からオブジェクトを追加する
  →通常のバーコードが追加される

  それの右クリックメニュー「Microsoft BarCode Control 15.0 オブジェクト」の
  「プロパティ」を表示する
  その中の「スタイル」を「11 - QRコード」に変更
  →形状がQRコードになる

  右クリックメニュー「プロパティ」中の「LinkedCell」にセル番号を入れるか
  「Value」に直接値を入れるかする
  →QRコードの内容に反映される
分類:ExcelVBA
ExcelVBA/図形をセルに収める
2020年05月07日
図形(オートシェイプ、ActiveXコントロール)の左上が属するセルに
その図形を収めるマクロ。
┌──────────────────────────────────────┐
│Dim 図形 As Shape                                                           │
│For Each 図形 In ActiveSheet.Shapes                                         │
│    With 図形                                                               │
│        .Left = .TopLeftCell.Left                                           │
│        .Top = .TopLeftCell.Top                                             │
│        .Width = .TopLeftCell.Offset(, 1).Left - .TopLeftCell.Left          │
│        .Height = .TopLeftCell.Offset(1).Top - .TopLeftCell.Top             │
│    End With                                                                │
│Next 図形                                                                   │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/セル結合への値代入
2020年03月26日
セル結合した領域に値を代入するとエラーとなる。(値のクリアも同様)
┌───────────────────┐
│実行時エラー'1004':                   │
│この操作は結合したセルには行えません。│
└───────────────────┘

対処法としては、「.MergeArea」をかませればよい。
┌────────────────────────────┐
│×セル.Value = 値     →  ○セル.MergeArea.Value = 値   │
│×セル.ClearContents  →  ○セル.MergeArea.ClearContents│
└────────────────────────────┘
分類:ExcelVBA
ExcelVBA/日時型
2019年12月20日
ExcelVBAの日時型はDateTime型ではなく、Date型である。
「日付+時間」型みたいなイメージと思ってよいようだ。
┌──────────────────────────────────────┐
│Dim 日時 As Date                                                            │
│日時 = "2019/12/20 12:34:56"                                                │
│MsgBox DateValue(日時)                    '→「2019/12/20」                 │
│MsgBox TimeValue(日時)                    '→「12:34:56」                   │
│MsgBox DateValue(日時) + TimeValue(日時)  '→「2019/12/20 12:34:56」        │
│MsgBox TimeValue(DateValue(日時))         '→「0:00:00」(2019/12/20 0:00:00)│
│MsgBox DateValue(TimeValue(日時))         '→「0:00:00」                    │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/矩形図形の重なりを着色
2019年12月19日
┌──────────────────────────────────────┐
│Sub 矩形図形の重なりを着色()                                                │
│    '-----------------------------------------------------------------------│
│    '  一旦クリア                                                           │
│    '-----------------------------------------------------------------------│
│    Dim 図形 As Shape                                                       │
│    With ActiveSheet                                                        │
│        For Each 図形 In .Shapes                                            │
│            If 図形.Type = msoShapeRectangle Then                           │
│                図形.Fill.ForeColor.RGB = RGB(255, 255, 255)                │
│            End If                                                          │
│        Next 図形                                                           │
│    End With                                                                │
│    '-----------------------------------------------------------------------│
│    '  重なりを着色                                                         │
│    '-----------------------------------------------------------------------│
│    Dim 図形1 As Shape, 図形2 As Shape                                      │
│    Dim i1 As Long, i2 As Long                                              │
│    With ActiveSheet                                                        │
│        For i1 = 1 To .Shapes.Count                                         │
│            If .Shapes(i1).Type = msoShapeRectangle Then                    │
│                Set 図形1 = .Shapes(i1)                                     │
│                For i2 = i1 + 1 To .Shapes.Count                            │
│                    If .Shapes(i2).Type = msoShapeRectangle Then            │
│                        Set 図形2 = .Shapes(i2)                             │
│                        If is重層(図形1.Top, _                              │
│                                  図形1.Top + 図形1.Height, _               │
│                                  図形1.Left, _                             │
│                                  図形1.Left + 図形1.Width, _               │
│                                  図形2.Top, _                              │
│                                  図形2.Top + 図形2.Height, _               │
│                                  図形2.Left, _                             │
│                                  図形2.Left + 図形2.Width) Then            │
│                            図形1.Fill.ForeColor.RGB = RGB(255, 0, 0)       │
│                            図形2.Fill.ForeColor.RGB = RGB(255, 0, 0)       │
│                        End If                                              │
│                    End If                                                  │
│                Next i2                                                     │
│            End If                                                          │
│        Next i1                                                             │
│    End With                                                                │
│End Sub                                                                     │
├──────────────────────────────────────┤
│Private Function is重層( _                                                  │
│    ByVal 上1 As Single, ByVal 下1 As Single, _                             │
│    ByVal 左1 As Single, ByVal 右1 As Single, _                             │
│    ByVal 上2 As Single, ByVal 下2 As Single, _                             │
│    ByVal 左2 As Single, ByVal 右2 As Single _                              │
│) As Boolean                                                                │
│    is重層 = IIf(左1 < 右2 And 左2 < 右1 And 上1 < 下2 And 上2 < 下1, _     │
│                 True, _                                                    │
│                 False)                                                     │
│End Function                                                                │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/チャート描画
2019年12月18日
四角形で描画するとこんな感じ。
┌──────────────────────────────────────┐
│Sub 描画(ByVal y開始 As Long, _                                             │
│         ByVal x開始 As Long, _                                             │
│         ByVal y終了 As Long, _                                             │
│         ByVal x終了 As Long, _                                             │
│         ByVal 文言 As String)                                              │
│    Dim 図形 As Shape                                                       │
│    With ActiveSheet                                                        │
│        Set 図形 = .Shapes.AddShape( _                                      │
│            msoShapeRectangle, _                                            │
│            .Cells(y開始, x開始).Left, _                                    │
│            .Cells(y開始, x開始).Top, _                                     │
│            .Cells(y終了 + 1, x終了 + 1).Left - .Cells(y開始, x開始).Left, _│
│            .Cells(y終了 + 1, x終了 + 1).Top - .Cells(y開始, x開始).Top _   │
│        )                                                                   │
│    End With                                                                │
│    With 図形                                                               │
│        .Fill.ForeColor.RGB = RGB(255, 255, 255)                            │
│        .Line.ForeColor.RGB = RGB(0, 0, 0)                                  │
│        With .TextFrame2.TextRange.Font                                     │
│            .Size = 9                                                       │
│            .Name = "MS ゴシック"                                         │
│        End With                                                            │
│        With .TextFrame                                                     │
│            .HorizontalAlignment = xlHAlignCenter                           │
│            .VerticalAlignment = xlVAlignCenter                             │
│            .Characters.Font.Color = RGB(0, 0, 0)                           │
│            .Characters.Text = 文言                                         │
│        End With                                                            │
│    End With                                                                │
│End Sub                                                                     │
└──────────────────────────────────────┘

ちなみに、事前に全削除するには以下のような感じ。
┌──────────────────────────────────────┐
│Dim 図形 As Shape                                                           │
│With ActiveSheet                                                            │
│    For Each 図形 In .Shapes                                                │
│        If 図形.Type = msoShapeRectangle Then                               │
│            図形.Delete                                                     │
│        End If                                                              │
│    Next 図形                                                               │
│End With                                                                    │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/セル範囲から各種値を取得
2019年12月16日
┌──────────────────────────────────────┐
│Dim セル範囲 As Range                                                       │
├──────────────────────────────────────┤
│MsgBox "セル名:" & セル範囲.Address                                        │
│MsgBox "シート名:" & セル範囲.Parent.Name                                  │
│MsgBox "ブック名:" & セル範囲.Parent.Parent.Name                           │
└──────────────────────────────────────┘
セルの親がシートで、おじいちゃんがブックという関係になる。
分類:ExcelVBA
ExcelVBA/別ブックを開く場合にイベントを抑止
2019年12月13日
ブック(Excelファイル)を開く際に、以下のようにイベントを定義していたとする。
┌──────────────────────────────────────┐
│Private Sub Workbook_Open()                                                 │
│    ' イベント                                                              │
│End Sub                                                                     │
└──────────────────────────────────────┘
このブックを他から開いた場合に、このイベントが発動してしまうが
これを抑止する方法。

以下のようにファイルを開く直前にイベントを抑止すればよい。
┌──────────────────────────────────────┐
│Dim ブック As Workbook                                                      │
│Application.EnableEvents = False    '←★イベント抑止                       │
│Set ブック = Workbooks.Open(Filename:="(入力ファイルのパス)")               │
│Application.EnableEvents = True     '←★イベント抑止の解除                 │
│'(各種処理)                                                                 │
│ブック.Close SaveChanges:=False                                             │
└──────────────────────────────────────┘
一旦、開いてしまえば、こちらのイベントは無関係となるので
イベント抑止を元に戻してあげてよい。

なお、他のイベント(入力イベントなど)についても考え方は同じ。
分類:ExcelVBA
ExcelVBA/一頁で印刷する方法
2019年12月12日
【方法1】「拡大縮小印刷」の「次のページ数に合わせて印刷 横1×縦1」を行う
┌──────────────────────────────────────┐
│With ActiveSheet.PageSetup                                                  │
│    .Zoom = False                                                           │
│    .FitToPagesWide = 1                                                     │
│    .FitToPagesTall = 1                                                     │
│End With                                                                    │
│' 印刷範囲の点線表示は変わらないのでわざと画面を切り替える                  │
│With ActiveWindow                                                           │
│    If .View = xlPageBreakPreview Then                                      │
│        .View = xlNormalView                                                │
│    End If                                                                  │
│    .View = xlPageBreakPreview                                              │
│End With                                                                    │
└──────────────────────────────────────┘
────────────────────────────────────────
【方法2】頁の境目を最端までドラッグ&ドロップする(拡大率指定のままで実現)
┌──────────────────────────────────────┐
│With ActiveSheet                                                            │
│    If .VPageBreaks.Count > 0 Then                                          │
│        .VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1        │
│    End If                                                                  │
│    If .HPageBreaks.Count > 0 Then                                          │
│        .HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1           │
│    End If                                                                  │
│End With                                                                    │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/固定頁の印刷設定
2019年12月11日
一頁目と同じサイズの二頁目以降がある場合に、印刷範囲を設定する方法
┌──────────────────────────────────────┐
│Sub 頁印刷範囲設定()                                                        │
│    Const 列数 As Long = 10                                                 │
│    Const 行数 As Long = 60                                                 │
│    Const 頁数 As Long = 5                                                  │
│    Dim i As Long                                                           │
│    With ActiveSheet                                                        │
│        ' ①念のため(頁数設定ではなく)拡大率設定にする                      │
│        .PageSetup.Zoom = 100                                               │
│        ' ②任意の改頁を全クリアする                                        │
│        .ResetAllPageBreaks                                                 │
│        ' ③一旦、印刷範囲を一頁目に絞る                                    │
│        .PageSetup.PrintArea = Range(.Cells(1, 1), .Cells(行数, 列数))      │
│        ' ④自然な改頁をすべて除去する                                      │
│        If .VPageBreaks.Count > 0 Then                                      │
│            .VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1    │
│        End If                                                              │
│        If .HPageBreaks.Count > 0 Then                                      │
│            .HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1       │
│        End If                                                              │
│        ' ⑤印刷範囲を最大にする                                            │
│        .PageSetup.PrintArea _                                              │
│            = Range(.Cells(1, 1), .Cells(行数 * 頁数, 列数))                │
│        ' ⑥任意の改頁を決まった行ごとに設定する                            │
│        For i = 1 To 頁数                                                   │
│            .HPageBreaks.Add Rows(i * 行数 + 1)                             │
│        Next i                                                              │
│    End With                                                                │
│End Sub                                                                     │
└──────────────────────────────────────┘
分類:ExcelVBA
前へ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 … 27 次へ