MW211 EXIT

devlog
ExcelVBA/図形のシート間全コピー
2018年07月21日
┌──────────────────────────────────────┐
│Dim i As Integer                                                            │
│Dim 図形名 As String, 上 As Double, 左 As Double, 縦 As Double, 横 As Double│
│With 入力シート                                                             │
│    For i = 1 To .Shapes.Count                                              │
│        With .Shapes(i)                                                     │
│            図形名 = .Name                                                  │
│            上 = .Top                                                       │
│            左 = .Left                                                      │
│            縦 = .Height                                                    │
│            横 = .Width                                                     │
│            .Copy                                                           │
│        End With                                                            │
│        With 出力シート                                                     │
│            .Select                                                         │
│            .Paste                                                          │
│            If VarType(Selection) = vbObject Then                           │
│                Selection.Name = 図形名  ' 日本語既定名は英語になるので注意 │
│            End If                                                          │
│            With .Shapes(図形名)                                            │
│                .Top = 上                                                   │
│                .Left = 左                                                  │
│                .Height = 縦                                                │
│                .Width = 横                                                 │
│            End With                                                        │
│            .Cells(1, 1).Select                                             │
│        End With                                                            │
│    Next i                                                                  │
│End With                                                                    │
└──────────────────────────────────────┘
コピーして名称を合わせて位置も合わせた。

AcitiveXコントロールの場合は、ペーストを選択(Selection)されない代わり
図形名は同じになるので、それ以外の場合のみ図形名を合わせる処理を行い
その後、図形名が同じという前提で、位置を合わせた。

なお、日本語既定名は実体は英語名なので、英語名としてコピーされてしまう。
分類:ExcelVBA
Excel/図形の名前の既定値のなぞ
2018年07月20日
そのオートシェイプを選択した状態で、画面左上の窓(名前ボックス)には
確かに「テキスト ボックス 1」と表示されているのだが、
ExcelVBAの名前取得では「Text Box 1」となってしまう件。

典型的な例が以下。
┌──────────────────────────────────────┐
│MsgBox シート.Shapes("テキスト ボックス 1").Name           '→「Text Box 1」│
└──────────────────────────────────────┘
確かに「テキスト ボックス 1」でオートシェイプを指定できているのにも関わらず
名前属性(.Name)を取得してみたら「Text Box 1」なのだ。

これは既定の場合にのみ起きる怪現象で、名前を変更すれば両者の乖離は解消する。

どうやら、既定値を気を利かして和訳表示したものの、
ExcelVBAと辻褄が合わなくなったことによるようだ。

この場合、名前属性(.Name)で「テキスト ボックス 1」の方を
取得する方法はないようなので、
気になるなら名前属性(.Name)を任意のものに変更するしかないようだ。

任意のものといっても思いつかないという場合には、自身を代入しなおせばよい。
┌──────────────────────────────────────┐
│With シート.Shapes("テキスト ボックス 1")                                   │
│    .Name = .Name                                                           │
│End With                                                                    │
└──────────────────────────────────────┘
すると、「Text Box 1」に名前ボックスの表示も統一される。

以後「テキスト ボックス 1」は使えないが………と思ったら、
以下は引き続き使えてしまった。
┌──────────────────────────────────────┐
│MsgBox シート.Shapes("テキスト ボックス 1").Name           '→「Text Box 1」│
└──────────────────────────────────────┘

ちなみに名前属性(.Name)を関係ないものに変更して実験してみた。
┌──────────────────────────────────────┐
│MsgBox シート.Shapes("テキスト ボックス 1").Name             '→変更した名前│
├──────────────────────────────────────┤
│MsgBox シート.Shapes("Text Box 1").Name                      '→エラー      │
└──────────────────────────────────────┘
つまり、英語側の既定値はまさに既定値で最初だけ有効(変名したそちらへ)なのだが
日本語側の既定値は半永久的に使える存在なのかもしれない。

ややこし過ぎる。
分類:ExcelVBA
ExcelVBA/図形の全削除
2018年07月19日
┌──────────────────────────────────────┐
│Dim i As Integer                                                            │
│With シート                                                                 │
│    For i = .Shapes.Count To 1 Step -1                                      │
│        .Shapes(i).Delete                                                   │
│    Next i                                                                  │
│End With                                                                    │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/オートシェイプ(テキストボックス)のコピー
2018年07月18日
┌──────────────────────────────────────┐
│入力シート.Shapes("テキスト ボックス").Copy                                 │
│With 出力シート                                                             │
│    .Cells(3, 3).Select                                                     │
│    .Paste                                                                  │
│End With                                                                    │
└──────────────────────────────────────┘
テキストボックスに数式(参照先)が設定されていたら
そのまま相対的にコピー先のセル(参照先)を指すことになる。
分類:ExcelVBA
ExcelVBA/ブックの上書保存(2)
2018年07月15日
では、自前で上書保存か否かの判断を行うには?
┌──────────────────────────────────────┐
│If Dir(保存先) = "" Then                                                    │
│    ' 既存なし(上書保存ではなく新規保存)                                    │
│Else                                                                        │
│    ' 既存あり(上書保存)                                                    │
│End If                                                                      │
└──────────────────────────────────────┘
Dir()で保存先があれば戻り値が帰ってくるので、それがあるか否かで判断できる

例えば、ファイル選択ダイアログと組み合わせた場合には
以下のような処理となる。
(上書を拒否したら再度選択画面に戻る仕組みとなっている)
┌──────────────────────────────────────┐
│Function 保存先選択() As String                                             │
│    Dim メッセージ As String                                                │
│    Dim 保存先 As Variant                                                   │
│    Dim ファイル名 As String                                                │
│    ファイル名 = "初期表示ファイル名.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                                                                │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/ブックの上書保存(1)
2018年07月14日
基本的に、以下のようにブックを保存した場合、保存先のパスに同一ファイル名があると
保存するか否かのダイアログが開いてしまう。
(そこで「いいえ」とかにするとエラーになってしまう)
┌──────────────────────────────────────┐
│ブック.SaveAs Filename:=保存先, _                                           │
│              FileFormat:=XlFileFormat.xlOpenXMLWorkbook                    │
└──────────────────────────────────────┘

これを避けるためには、その前後で、
警告メッセージ(DisplayAlerts)を一時的に切ればよい。
┌──────────────────────────────────────┐
│Application.DisplayAlerts = False                                           │
│ブック.SaveAs Filename:=保存先, _                                           │
│              FileFormat:=XlFileFormat.xlOpenXMLWorkbook                    │
│Application.DisplayAlerts = True                                            │
└──────────────────────────────────────┘
シート削除(こちらも確認ダイアログが開く)時と同じ要領だ。
分類:ExcelVBA
ExcelVBA/続・セル選択イベントを一つのセルで
2018年07月03日
┌──────────────────────────────────────┐
│Private Sub Worksheet_SelectionChange(ByVal Target As Range)                │
│    If Target.CountLarge <> 1 Then                                          │
│        Exit Sub                                                            │
│    End If                                                                  │
│    If Target.Column = 対象列番号 Then                                      │
│        Call イベント                                                       │
│    End If                                                                  │
│End Sub                                                                     │
└──────────────────────────────────────┘
だと、セル結合された一塊を選択した場合にはじかれてしまう。

上記を克服したものは以下である。
┌──────────────────────────────────────┐
│Private Sub Worksheet_SelectionChange(ByVal Target As Range)                │
│    If Target.CountLarge <> Target(1).MergeArea.Count Then                  │
│        Exit Sub                                                            │
│    End If                                                                  │
│    If Target.Column = 対象列番号 Then                                      │
│        Call イベント                                                       │
│    End If                                                                  │
│End Sub                                                                     │
└──────────────────────────────────────┘
全体の選択数と左上のセル結合数が一致した場合にのみイベント発動としている。
セル結合がないひとつのセルを選択した場合には「1=1」でイベントう発動。
分類:ExcelVBA
ExcelVBA/セル選択イベントを一つのセルで
2018年07月02日
セル選択に伴いイベントを駆動するには以下のような形になる。
┌──────────────────────────────────────┐
│Private Sub Worksheet_SelectionChange(ByVal Target As Range)                │
│    If Target.Column = 対象列番号 Then                                      │
│        Call イベント                                                       │
│    End If                                                                  │
│End Sub                                                                     │
└──────────────────────────────────────┘

但し「Target」はセル範囲なので、一つのセルとは限らない。

セルが一つの場合に限定するには、「.CountLarge」の値を見る。
┌──────────────────────────────────────┐
│Private Sub Worksheet_SelectionChange(ByVal Target As Range)                │
│    If Target.CountLarge <> 1 Then                                          │
│        Exit Sub                                                            │
│    End If                                                                  │
│    If Target.Column = 対象列番号 Then                                      │
│        Call イベント                                                       │
│    End If                                                                  │
│End Sub                                                                     │
└──────────────────────────────────────┘
なお、旧バージョン(.xls)では「.Count」というのがあったが
新バージョン(.xlsm)対応の「.CountLarge」を使った方がよい。
(さもないとず~っと右端のセルを選択した場合にはオーバフローでエラーとなる)
分類:ExcelVBA
ExcelVBA/二次元配列の行抽出
2018年07月01日
セル範囲を二次元配列に格納して、特定の列の特定の値の行のみ抽出する関数。
もっとスマートな方法がありそうだが。
┌──────────────────────────────────────┐
│Private Function 二次元配列行抽出(ByVal 入力配列 As Variant, _              │
│                                  ByVal x抽出 As Long, _                    │
│                                  ByVal 値 As String) As Variant            │
│    Dim 出力配列 As Variant                                                 │
│    Dim y出力 As Long, y入力 As Long, x As Long                             │
│    ' 該当件数調査                                                          │
│    y出力 = 0                                                               │
│    For y入力 = LBound(入力配列, 1) To UBound(入力配列, 1)                  │
│        If 入力配列(y入力, x抽出) = 値 Then                                 │
│            y出力 = y出力 + 1                                               │
│        End If                                                              │
│    Next y入力                                                              │
│    ' 該当なしの場合は空の一行を返却                                        │
│    If y出力 = 0 Then                                                       │
│        ReDim 出力配列(1, 1 To UBound(入力配列, 2))                         │
│        二次元配列行抽出 = 出力配列                                         │
│        Exit Function                                                       │
│    End If                                                                  │
│    ' 抽出                                                                  │
│    ReDim 出力配列(1 To y出力, 1 To UBound(入力配列, 2))                    │
│    y出力 = 0                                                               │
│    For y入力 = LBound(入力配列, 1) To UBound(入力配列, 1)                  │
│        If 入力配列(y入力, x抽出) = 値 Then                                 │
│            y出力 = y出力 + 1                                               │
│            For x = LBound(入力配列, 2) To UBound(入力配列, 2)              │
│                出力配列(y出力, x) = 入力配列(y入力, x)                     │
│            Next x                                                          │
│        End If                                                              │
│    Next y入力                                                              │
│    二次元配列行抽出 = 出力配列                                             │
│End Function                                                                │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/配列とOption Base
2018年06月30日
┌──────────────────────────────────────┐
│Dim 配列(2)    '=配列(0 To 2)  =配列(0)と配列(1)と配列(2)  ※配列数3      │
└──────────────────────────────────────┘
VBAの配列定義はくせがあって上記のように配列定義と配列数が一致しない。

┌──────────────────────────────────────┐
│Option Base 0  ' 既定                                                       │
│Dim 配列(2)    '=配列(0 To 2)  =配列(0)と配列(1)と配列(2)                 │
├──────────────────────────────────────┤
│Option Base 1                                                               │
│Dim 配列(2)    '=配列(1 To 2)  =配列(1)と配列(2)                          │
└──────────────────────────────────────┘
「Option Base 1」を最初に宣言すると、1オリジンで、
配列定義=配列数=最大配列添字とすることができる。

なお、セル範囲を配列化した場合は1オリジンなのでこちらと同じになる。

いずれにせよ、C系定義と違いがあるので注意。
分類:ExcelVBA
前へ 1 … 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 … 27 次へ