Excel マクロ(VBA) でシートを名前順でソートする
備忘録としてVBAマクロを掲載していくシリーズ。
シートをシート名昇順にソートするマクロ。
Excel マクロ(VBA) でシート一覧を作成の応用。
Sub シートをソート() ' 画面更新を一時的に無効化する。 Application.ScreenUpdating = False Dim cnt As Long cnt = Sheets.count ' 作業用シートをブック先頭に作成 Dim work As Worksheet Set work = Worksheets.Add(Sheets(1)) ' シート名一覧を作成する処理 Dim i As Long For i = 1 To cnt work.Cells(i, 1) = Sheets(i).Name Next i ' 一覧をExcel標準機能でソート work.Range("A1:A" & i).Sort Key1:=Range("A1"), _ Order1:=xlAscending, _ Header:=xlGuess ' 一覧の順番通りにシートを並べ替える For i = 1 To cnt Sheets(work.Cells(i, 1).Value).Move before:=work Next i ' シート削除時の警告表示を停止 Application.DisplayAlerts = False ' 作業用シートを削除 work.Delete ' 警告表示を再開する Application.DisplayAlerts = False ' 画面更新を再開する Application.ScreenUpdating = True End Sub
Excel マクロ(VBA) でブック内の画像をすべて取り除く
備忘録としてVBAマクロを掲載していくシリーズ。
ブック内に大量に画像が張り付けてあって、それをすべて消す作業が発生したので、めんどくさくなったので下記のマクロにて処理。
まず、アクティブなシート内の画像を全て消す処理は、下記。
ActiveWorksheet.Pictures.Delete
これをForループで全シートに対して順次行ってあげるだけ。
Sub 画像をすべて取り除く() Dim sht As Variant For Each sht In Sheets sht.Pictures.Delete Next sht End Sub
Excel マクロ(VBA) で対象セルに画像を張り付ける
備忘録としてVBAマクロを掲載していくシリーズ。
指定したセル上に、セルに寸法を合わせた画像を貼り付ける処理。
指定したセルが結合されたセルの場合、結合したセル全体のサイズに合わせる。
まずコア部分。
引数は下記の通り。
tgtRange : 貼り付ける先のセル(結合セルの場合は左上のセルを指定。)
fname : 貼り付ける画像のパス(省略した場合は、対象のセルに記入されたパスを参照する)
Function 対象セルに画像を張り付ける(ByRef tgtRange, Optional fname As String) If fname = "" Then If tgtRange.Text = "" Then Exit Function fname = Replace(ActiveWorkbook.FullName, _ ActiveWorkbook.Name, "") & tgtRange.Text End If ' 貼り付け位置・サイズの調整 ' ( Width, Heightの指定が必須のため、仮の値を設定 ) Dim objShape Set objShape = tgtRange.Parent.Shapes.AddPicture( _ Filename:=fname, _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=tgtRange.Left + 1, _ Top:=tgtRange.Top + 1, _ Width:=tgtRange.MergeArea.Width, _ Height:=tgtRange.MergeArea.Height) With objShape .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue '.LockAspectRatio = msoTrue '縦横費を固定。 .Width = tgtRange.MergeArea.Width .Height = tgtRange.MergeArea.Height End With End Function
現在アクティブなセルに対して、画像選択ダイアログを開いて貼り付けるには、下記の関数を追加する。「Ctrl+Shift+V」とかショートカットを設定しておくと一発起動できて便利。
Sub 写真貼り付け() ' ' 写真貼り付け Macro ' ' Keyboard Shortcut: Ctrl+Shift+V Dim t As Range Set t = ActiveCell Dim fname As String fname = Application.GetOpenFilename ' ファイル選択ダイアログを開く。 If fname = "False" Then fname = "" ' ※ GetOpenFilename は、ファイルが選択されなかった時には、 ' 文字列"False"を返す。 Call 対象セルに画像を張り付ける(t, fname) End Sub
Excel マクロ(VBA) でシート一覧を作成
備忘録としてVBAマクロを掲載していくシリーズ。
いまあるシート名一覧を出力する方法。
ブックの末尾に新たにシートを追加して、そこに現在あるシート名一覧を出力する。
Sub シート一覧を作成() Dim cnt as Long cnt = Sheets.Count Dim work As Worksheet Set work = Worksheets.Add(, Sheets(cnt)) Dim i As Long For i = 1 To cnt work.Cells(i, 1) = Sheets(i).Name Next i End Sub