ゴミ溜め@技術系日常系雑文

主にWeb技術やそのほかつまづいたこととか引っかかって調べたこととかをまとめてます。

はてなダイアリーから引っ越しました。)

右クリックで選択したファイルを一括して新しいフォルダに移動するバッチ書いた

複数のファイルを同じフォルダに格納したいんだけど、いちいち新規フォルダ作成→ファイルを選択→ドラッグ&ドロップって言う操作が面倒なので、複数のファイルを選択して、右クリック(コンテキスト)メニューから一括で出来るようにした。

続きを読む

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