MW211 EXIT

devlog
ExcelVBA/テキストボックスの数式は255文字制限
2018年08月15日
テキストボックスの数式欄にセル参照を指定すると
そのセルの内容をテキストボックス内に表示できるが
最大255文字までという制限がある。(末尾が途切れてしまう)

代案は以下の通り

○「ActiveXコントロールのテキストボックス」のLinkedCellにセル参照を設定
  △稀に印刷時にExcel例外が発生する場合がある
    →但し、LinkedCellに一旦別のセル参照を設定してみると回避できた

×「テキストボックス」の数式欄にセル参照を設定
  ×255文字までしか表示できない

×「画像」の数式欄にセル参照を設定
  ×元セルの表示領域しか表示できない
    画像扱いなので領域を拡大すると文字サイズが大きくなる

×「フォームコントロールのラベル」の数式欄にセル参照を設定
  ×255文字しか表示できない
  ×フォントの指定ができない
  ×罫線の指定ができない

×「ActiveXコントロールのラベル」
  ×セル参照を設定できない
分類:ExcelVBA
Excel/ActiveXコントロールのテキストボックス
2018年08月14日
ActiveXコントロールのテキストボックスを
一般的なテキストボックスのようににする設定。

いかにも入力欄のような凹凸をなくし(SpecialEffect)、
逆に枠線を引く(BorderStyle)。
┌───────┬────────────┬────────────┐
│              │         既定値         │         設定値         │
├───────┼────────────┼────────────┤
│SpecialEffect │2-fmSpecialEffectSunken │0-fmSpecialEffectFlat   │
├───────┼────────────┼────────────┤
│BorderStyle   │0-fmBorderStyleNone     │1-fmBorderStyleSingle   │
├───────┼────────────┼────────────┤
│MultiLine     │False                   │True                    │
└───────┴────────────┴────────────┘

入力不可にもできるが(Enabled)、文字色が灰色がかるのが難点。
┌───────┬────────────┬────────────┐
│              │         既定値         │         設定値         │
├───────┼────────────┼────────────┤
│Enabled       │True                    │False                   │
└───────┴────────────┴────────────┘
分類:ExcelVBA
ExcelVBA/ADODBデータベースに時間がかかる場合
2018年08月10日
以下のパラメータ値(プロパティ値)を変更(大きく)すればよい。(以下は既定値)
┌──────────────────────────────────────┐
│Dim データベース As New ADODB.Connection                                    │
│With データベース                                                           │
│    .ConnectionTimeout = 15                                                 │
│    .CommandTimeout = 30                                                    │
│End  With                                                                   │
└──────────────────────────────────────┘
┌─────────┬────────────────────────────┐
│.ConnectionTimeout│接続まで時間がかかる場合                                │
│                  │ネットワークの調子が悪い場合向け                        │
├─────────┼────────────────────────────┤
│.CommandTimeout   │SQL応答に時間がかかる場合                               │
│                  │重い(複雑な)SQL文を待つ場合向け                         │
└─────────┴────────────────────────────┘
分析系など特別なプログラムの場合には後者の値を大きくする感じか。
分類:ExcelVBA
ExcelVBA/ADODBの列未指定≠INSERT文の列未指定
2018年08月06日
SQL文のDEFAULT定義は、あくまで列が指定されなかった場合の既定値であり
NULLを代入した場合の代替値ではないことに注意。
○INSERT文にて列が指定されなかった場合には基本的にNULLが代入される
○この場合、DEFAULT定義があった場合にはその値が代入される
○UPDATE文にてNULLを代入しても、DEFAULT定義の値は無視される
×INSERT文にてNULLを代入したら、DEFAULT定義の値が代入される
  →NULLが代入される

よって、NOT NULL制約とDEFAULT定義が両方定義してある列について
DEFAULT定義があるから(NOT NULL制約にはひっかからなくて)安心というのは間違いだ。

そして、それが如実に現れるのがExcelVBAのADODB。

「テーブル.AddNew」した瞬間に、全ての列にNULLがセットされるので
「テーブル.Fields(列).Value = 値」で値を代入しないと
NULLが代入されることになる。(列が指定されないのではない)

例えば、「列2」に対する代入処理がない場合は、以下のような扱いになる訳だ。
┌─┬────────────────────────────────────┐
│×│INSERT 表 (列1)      VALUES (値2);                                      │
├─┼────────────────────────────────────┤
│○│INSERT 表 (列1, 列2) VALUES (値1, NULL);                                │
└─┴────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/塊ごとに番号
2018年07月31日
キー列の値が同じ行が続くものを塊ともなし、
その塊ごとに番号を振る方法はないようなので、マクロを組んだ。

以下のような番号(二列目)を振りたいわけだ。
┌─┬─┐
│A │ 1│
├─┼─┤
│A │ 1│
├─┼─┤
│B │ 1│
├─┼─┤
│A │ 2│
├─┼─┤
│C │ 1│
├─┼─┤
│A │ 3│
└─┴─┘

┌──────────────────────────────────────┐
│Const X_キー As Long = 1                                                    │
│Const X_番号 As Long = 2                                                    │
│Dim yMax As Long, y1 As Long, y2 As Long                                    │
│Dim 番号 As Long, is違 As Boolean                                           │
│With シート                                                                 │
│    yMax = .UsedRange.Rows(.UsedRange.Rows.Count).Row                       │
│    .Columns(X_番号).ClearContents                                          │
│    For y1 = 1 To yMax                                                      │
│        If .Cells(y1, X_番号).Value = "" Then                               │
│            is違 = False                                                    │
│            番号 = 1                                                        │
│            For y2 = y1 To yMax                                             │
│                If .Cells(y2, X_キー).Value = .Cells(y1, X_キー).Value Then │
│                    If is違 Then                                            │
│                        is違 = False                                        │
│                        番号 = 番号 + 1                                     │
│                    End If                                                  │
│                    .Cells(y2, X_番号).Value = 番号                         │
│                Else                                                        │
│                    is違 = True                                             │
│                End If                                                      │
│            Next y2                                                         │
│        End If                                                              │
│    Next y1                                                                 │
│End With                                                                    │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/現在日から初日の求め方
2018年07月28日
┌──────────────────────────────────────┐
│Dim nowDate As Date: nowDate = Date                                         │
├──────────────────────────────────────┤
│月初日 = DateSerial(Year(nowDate), Month(nowDate), 1)                       │
├──────────────────────────────────────┤
│Const 期首月 As Long = 4                                                    │
│期首日 = IIf(Month(nowDate) < 期首月, _                                     │
│             DateSerial(Year(nowDate) - 1, 期首月, 1),                      │
│             DateSerial(Year(nowDate), 期首月, 1))                          │
├──────────────────────────────────────┤
│年初日 = DateSerial(Year(nowDate), 1, 1)                                    │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/図形をセルに合わせて配置
2018年07月27日
┌──────────────────────────────────────┐
│With シート                                                                 │
│    .図形.Top = .セル.Top                                                   │
│    .図形.Left = .セル.Left                                                 │
│End With                                                                    │
└──────────────────────────────────────┘
上記のように縦位置(.Top)と横位置(.Left)を合わせてあげればよい。

もう少し具体的に記述するなら以下のような感じ。
┌──────────────────────────────────────┐
│With ThisWorkbook.Worksheets("シート")                                      │
│    .Shapes("テキスト ボックス").Top = .Cells(y, x).Top                     │
│    .Shapes("テキスト ボックス").Left = .Cells(y, x).Left                   │
│End With                                                                    │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/マクロを強制的に中断させる方法
2018年07月24日
┌─────────┬────────────────────────────┐
│Ctrl+Pause       │→「コードの実行が中断されました。」                    │
├─────────┼────────────────────────────┤
│ESC(を押し続ける) │同上                                                    │
└─────────┴────────────────────────────┘

中断させないようにする方法もある。(冒頭で設定を変えてしまう)
┌──────────────────────────────────────┐
│Application.EnableCancelKey = xlDisabled       ' 既定「xlInterrupt」から変更│
└──────────────────────────────────────┘
但し、これをすると制御不能となってしまう(*1)ので、注意。
*1:タスク(プロセス)の終了で強制終了させる他なくなる。
分類:ExcelVBA
ExcelVBA/シートをファイル出力するクラス
2018年07月23日
┌──────────────────────────────────────┐
│Option Explicit                                                             │
│'***************************************************************************│
│'  クラス:ファイル出力                                                     │
│'***************************************************************************│
│Private m出力シート As Worksheet                                            │
│'===========================================================================│
│'  コンストラクタ                                                           │
│'===========================================================================│
│Private Sub Class_Initialize()                                              │
│End Sub                                                                     │
│'===========================================================================│
│'  メソッド:準コンストラクタ                                               │
│'===========================================================================│
│Public Sub 準コンストラクタ(ByVal 出力シート名 As String)                   │
│    Set m出力シート = ThisWorkbook.Worksheets(出力シート名)                 │
│End Sub                                                                     │
│'===========================================================================│
│'  デストラクタ                                                             │
│'===========================================================================│
│Private Sub Class_Terminate()                                               │
│End Sub                                                                     │
│'===========================================================================│
│'  実行:ファイル出力                                                       │
│'===========================================================================│
│Private Sub 実行()                                                          │
│    Dim 出力先 As Variant                                                   │
│    ' 出力先選択                                                            │
│    出力先 = 出力先選択()                                                   │
│    If 出力先 = "" Then                                                     │
│        Exit Sub                                                            │
│    End If                                                                  │
│    ' 複写                                                                  │
│    m出力シート.Copy                                                        │
│    ' 保存                                                                  │
│    Application.DisplayAlerts = False   ' 確認ダイアログ抑止(強制上書)      │
│    ActiveWorkbook.SaveAs Filename:=出力先, _                               │
│                          FileFormat:=XlFileFormat.xlOpenXMLWorkbook        │
│    Application.DisplayAlerts = True    ' 確認ダイアログ抑止解除            │
│    ActiveWorkbook.Close SaveChanges:=False                                 │
│End Sub                                                                     │
│'===========================================================================│
│'  内部メソッド:出力先選択                                                 │
│'===========================================================================│
│Private Function 出力先選択() As String                                     │
│    Dim メッセージ As String                                                │
│    Dim 出力先 As Variant                                                   │
│    Dim ファイル名 As String                                                │
│    ファイル名 = ファイル名編集(m出力シート.Name) & ".xlsx" ' 初期表示      │
│    Do                                                                      │
│        出力先 = Application.GetSaveAsFilename( _                           │
│            InitialFileName:=ファイル名, _                                  │
│            FileFilter:="Excelファイル(*.xlsx),*.xlsx" _                    │
│        )                                                                   │
│        ' キャンセル                                                        │
│        If 出力先 = False Then                                              │
│            MsgBox "キャンセルされました。", vbInformation, "処理の中止"    │
│            出力先選択 = ""                                                 │
│            Exit Function                                                   │
│        End If                                                              │
│        ' 新規追加                                                          │
│        If Dir(出力先) = "" Then                                            │
│            Exit Do                                                         │
│        End If                                                              │
│        ' 上書の確認                                                        │
│        ファイル名 = Dir(出力先)                                            │
│        メッセージ = ファイル名 & " は既に存在します。" & vbCrLf _          │
│                   & "上書きしますか?"                                     │
│        If MsgBox(メッセージ, vbYesNo + vbExclamation, "処理の確認") _      │
│                                                                = vbYes Then│
│            Exit Do                                                         │
│        End If                                                              │
│    Loop                                                                    │
│    出力先選択 = 出力先                                                     │
│End Function                                                                │
│'===========================================================================│
│'  内部メソッド:ファイル名編集  ファイル使用不可文字を置換                 │
│'===========================================================================│
│Private Function ファイル名編集(ByVal ファイル名 As String) As String       │
│    ファイル名 = Replace(ファイル名, "<", "(")                              │
│    ファイル名 = Replace(ファイル名, ">", ")")                              │
│    ファイル名編集 = ファイル名                                             │
│End Function                                                                │
│'***************************************************************************│
└──────────────────────────────────────┘
シートをファイル出力するクラスも作ってみた。

以下のようにして使う。
┌──────────────────────────────────────┐
│Dim objファイル出力 As New Classファイル出力                                │
│Call objファイル出力.準コンストラクタ("出力")  ' 任意のシート名を指定       │
│Call objファイル出力.実行()                                                 │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/シートをマクロ抜きで複写するクラス
2018年07月22日
┌──────────────────────────────────────┐
│Option Explicit                                                             │
│'***************************************************************************│
│'  クラス:シート複写                                                       │
│'***************************************************************************│
│Private m入力シート As Worksheet                                            │
│'===========================================================================│
│'  コンストラクタ                                                           │
│'===========================================================================│
│Private Sub Class_Initialize()                                              │
│    Set m入力シート = ThisWorkbook.Worksheets("入力")  ' 任意のシート名を   │
│End Sub                                                                     │
│'===========================================================================│
│'  デストラクタ                                                             │
│'===========================================================================│
│Private Sub Class_Terminate()                                               │
│End Sub                                                                     │
│'===========================================================================│
│'  実行                                                                     │
│'===========================================================================│
│Public Sub 実行(ByVal シート名 As String)                                   │
│    Dim シート As Worksheet                                                 │
│    Application.ScreenUpdating = False  ' 作業過程非表示                    │
│    ' シート追加                                                            │
│    For Each シート In Worksheets                                           │
│        If シート.Name = シート名 Then                                      │
│            MsgBox "同一シート名が既に存在します。", vbCritical, "処理中止" │
│            Exit Sub                                                        │
│        End If                                                              │
│    Next シート                                                             │
│    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = シート名     │
│    ' シート複写                                                            │
│    Call マクロ抜きシート複写(m入力シート, _                                │
│                              ThisWorkbook.Worksheets(シート名))            │
│    '                                                                       │
│    Application.GoTo m入力シート.Cells(1, 1)                                │
│    Application.ScreenUpdating = True   ' 作業過程非表示の解除              │
│End Sub                                                                     │
│'===========================================================================│
│'  マクロ抜きシート複写                                                     │
│'===========================================================================│
│Private Sub マクロ抜きシート複写(ByVal 入力シート As Worksheet, _           │
│                                 ByVal 出力シート As Worksheet)             │
│    Dim 表示倍率 As Long, 改頁 As Variant                                   │
│    ' コピー                                                                │
│    入力シート.Cells.Copy  ' コピー                                         │
│    With 出力シート.Cells(1, 1)                                             │
│        .PasteSpecial Paste:=xlValues   ' 値貼り付け                        │
│        .PasteSpecial Paste:=xlFormats  ' 書式貼り付け                      │
│        .Select                                                             │
│    End With                                                                │
│    ' 印刷設定の複写                                                        │
│    Call 印刷設定の複写(入力シート.PageSetup, _                             │
│                        出力シート.PageSetup)                               │
│    ' 改頁位置の複写                                                        │
│    For Each 改頁 In 入力シート.HPageBreaks                                 │
│        出力シート.HPageBreaks.Add 改頁.Location.Rows                       │
│    Next 改頁                                                               │
│    ' 表示倍率の複写                                                        │
│    入力シート.Select                                                       │
│    表示倍率 = ActiveWindow.Zoom                                            │
│    出力シート.Select                                                       │
│    ActiveWindow.Zoom = 表示倍率                                            │
│    ' クリップボードのクリア                                                │
│    Application.CutCopyMode = False                                         │
│    ' 上記のみではクリアできないものについては、                            │
│    ' 全セル選択から一セル選択に切り替える                                  │
│    ' →「図が大きすぎます。」エラー対策                                    │
│    入力シート.Cells(1, 1).Copy                                             │
│End Sub                                                                     │
│'===========================================================================│
│'  印刷設定の複写                                                           │
│'===========================================================================│
│Private Sub 印刷設定の複写(ByVal 入力 As Object, _                          │
│                           ByVal 出力 As Object)                            │
│    With 出力                                                               │
│        ' ヘッダ・フッタの複写                                              │
│        .LeftHeader = 入力.LeftHeader                                       │
│        .CenterHeader = 入力.CenterHeader                                   │
│        .RightHeader = 入力.RightHeader                                     │
│        .LeftFooter = 入力.LeftFooter                                       │
│        .CenterFooter = 入力.CenterFooter                                   │
│        .RightFooter = 入力.RightFooter                                     │
│        ' 印刷タイトルの複写                                                │
│        .PrintTitleRows = 入力.PrintTitleRows                               │
│        ' 印刷範囲の複写                                                    │
│        .PrintArea = 入力.PrintArea                                         │
│        .PaperSize = 入力.PaperSize                                         │
│        .Orientation = 入力.Orientation                                     │
│        .Zoom = 入力.Zoom                                                   │
│        .FitToPagesTall = 入力.FitToPagesTall                               │
│        .FitToPagesWide = 入力.FitToPagesWide                               │
│    End With                                                                │
│End Sub                                                                     │
│'***************************************************************************│
└──────────────────────────────────────┘
シートをマクロ抜きで複写するクラスを作ってみた。

以下のようにして使う。
┌──────────────────────────────────────┐
│Dim objシート複写 As New Classシート複写                                    │
│Call objシート複写.実行("出力")  ' 任意のシート名を指定                     │
└──────────────────────────────────────┘

ただ、印刷範囲あたりの処理はナイーヴ(Excelのバグ?)なので、
ボタン等があればおかしくなる可能性もあるので注意して使用のこと。
分類:ExcelVBA
前へ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 … 27 次へ