セルに値を入力して図形の位置を変更する。
1 現状
Excelの出力シートに、項目が6個くらい書き出してありケースごとにどの項目に該当するかをオートシェイプの丸をマウスで動かしてから印刷している。
2 対策
入力セルに値を入れて、その値によってオートシェイプ図形を動かす。
3 (構想中)
sub
'どこのセルで判断するか入力。たとえばA1セル
dim cellAdd as string:cellAdd="A1"
dim Flag as long:Flag=activesheet.range(celladd)
dim x
dim y
select case Flag
case1
x=
y=
case2
x=
y=
case3
x=
y=
case4
case else
end serect
オートシェイプ.top=x座標
オートシェイプ.left=y座標
end sub
講師別、英語構文のカッコの使い方
敬称略
薬袋善郎 名詞節[]、形容詞節()、副詞節〈〉
出力原義(ひな型)シートを同一ブック内にコピーして一件別請求書シート作成
1 ひな型から同じブック内に複数シート作成
出力用のひな型シートには、あらかじめJ1セルを参照するVlookupを埋め込んである。削除してはまずい一覧シートやひな型シートは、シート名の冒頭に●をつけてある。
2 コード
Option Explicit Sub ひな型シートを同一ブック内にコピーして一件別シート作成() Application.ScreenUpdating = False '初期化 Call シート名が●で始まらないものを削除 Dim iRow As Long With ThisWorkbook.Sheets("●一覧") 'データ部分(見出し行以外)をループ For iRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row 'B列(発行判定列)が空欄でない場合(1が入っていたら) If .Range("B" & iRow) <> "" Then 'ひな型シートをコピー Sheets("●ひな型").Copy after:=Sheets(Sheets.Count) 'シート名を取引先名(C列)に変更 ActiveSheet.Name = .Range("C" & iRow) 'シートのJ1セル(ひな型のVLookupが検索値として参照するセル)に一覧シートの一連番号(A列)を入力 ActiveSheet.Range("J1") = .Range("A" & iRow) End If Next End With End Sub Sub シート名が●で始まらないものを削除() Application.ScreenUpdating = False If MsgBox("削除前に上書き保存しておきますか", vbYesNo, "削除前の確認") = vbYes Then ThisWorkbook.Save MsgBox "シート削除前に、上書き保存完了" End If Dim ws As Worksheet For Each ws In Sheets If ws.Name Like "●*" Then '何もしない(削除しない) Else Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True End If Next MsgBox "シート削除完了" & vbNewLine & "誤って削除した場合は保存せずに閉じてください。" End Sub
3 見本
『たった1秒で仕事が片づくExcel自動化の教科書』補足記事
の7章
シート名が●で始まっているもの以外を削除
1 原義シート(ひな型シート)以外を削除
残したい原義シート(ひな型シート)やマスターシートには、そのシート名に●をつけておき、他の作業シートを削除する。
2 コード
Option Explicit Sub シート名が●で始まらないものを削除() Application.ScreenUpdating = False If MsgBox("削除前に上書き保存しておきますか", vbYesNo, "削除前の確認") = vbYes Then ThisWorkbook.Save MsgBox "シート削除前に、上書き保存完了" End If Dim ws As Worksheet For Each ws In Sheets If ws.Name Like "●*" Then '何もしない(削除しない) Else Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True End If Next MsgBox "シート削除完了" & vbNewLine & "誤って削除した場合は保存せずに閉じてください。" End Sub
3 元ネタ
シート目次作成(目次シート→各シート、各シート→目次シートへのハイパーリンク)
Sub 目次作成() Dim ws目次 As Worksheet: Set ws目次 = Thisworkbook.Sheets("目次") ws目次.Range("A:A").ClearContents Dim i As Integer For i = 1 To ThisWorkbook.Sheets.Count '目次シート作成 With ws目次 .Hyperlinks.Add Anchor:=.Range("A" & i), _ Address:="", _ SubAddress:=ThisWorkbook.Sheets(i).Name & "!A1", _ TextToDisplay:=ThisWorkbook.Sheets(i).Name End With '各シート→目次シートリンク作成 With ThisWorkbook.Sheets(i) .Hyperlinks.Add Anchor:=.Range("I1"), _ Address:="", _ SubAddress:=ws目次.Name & "!A" & i, _ TextToDisplay:=ws目次.Name & "へ" End With Next End Sub
SaveAsと保存ファイル名の拡張子との整合性エラーの回避
1 前提
SaveAsメソッドによる保存でファイル名(ここでは、myFileNameとする)を指定するとき、ファイル名に拡張子まで含めることもできるし、拡張子の付加はSaveAsメソッドに任せることもできる。
2 課題
しかし、引数FileFormatの内容(FileFormatを省略してを既定にした場合を含む)と、myFileName内につけた拡張子との齟齬があるとエラーが出る。
3 対策
そこで、必ず引数FileFormatを設定することにして、myFileNameは拡張子なし(BaseNameのみ)とすることにした。拡張子の付加はSaveAsメソッドの引数FileFormatに任せる。
4 注意
なお、マクロを含まないxlsx形式で保存する場合は、
FileFormat:=xlWorkbookDefault
(参照 https://docs.microsoft.com/ja-jp/office/vba/api/excel.xlfileformat )
とするが、マクロが削除されてしまう旨の警告が出るので、displayAlertsをいったんFalseにする方がよい。
実行時エラー’1004 並べ替えの参照が正しくありません。
1 エラーメッセージ
実行時エラー’お1004
並べ替えの参照が正しくありません。参照が並べ替えるデータ内にあることと、[最優先されるキー]ボックスが空白でないことを確認してください。
2 原因
表をSortメソッドで並べ替えたしたときに発生。
最初はセル結合を疑ったが違った。
直接の原因は「参照が並べ替えるデータ内」になかったこと。
真の原因は、他人が作成した表のため列構成を完全に把握できていなかったため。20列程度の帳票だったが、非表示セルやセル幅を非常に小さくした列などがあり、そのうちの2列に空白列があった。そのため、Sort対象のRangeオブジェクトのCurrentRegionが想定よりも小さな表になってしまっており、その結果、Key1で指定したRangeがCurrentRegionの外になっていた。
以上により、key1で参照しているRangeが並べ替えるCurrentRegionのデータ内になかったためエラーが発生した。