Excel VBAのあれこれ

久しぶりにExcelでVBAを組んでみると、いろいろ忘れすぎててびっくりしたのでメモっておく。


'' ======================================
'' 既存のシートをコピーして新規ブックで保存
'' ======================================

Dim objNewBook As Workbook

' 新規ブックを作成
Set objNewBook = Workbooks.Add

' 既存のワークシートを新規ブックへコピー
Worksheets("テンプレ").Copy Before:= objNewBook.Worksheets("新規シート名")

' 新規ブックを保存
objNewBook.SaveAs "C:\テンプレから作成.xls"

objNewBook.close
Set objNewBook = Nothing



'' ======================================
'' ファイル選択ダイアログ
'' ======================================
Dim strFileFilter As String     ' 選択ダイアログのファイルフィルター
Dim strPath As String           ' 選択されているファイルのパス

' 選択できる拡張子はCSVと全てのファイル
strFileFilter = "CSVファイル(*.csv),*.csv" & _
                "Excelファイル(*.xls),*.xls" & _
                ",すべてのファイル(*.*),*.*"

' ダイアログの初期ディレクトリにカレントディレクトリをセット
ChDir (CurDir)

' ファイル選択ダイアログを開く
strPath = Application.GetOpenFilename(strFileFilter)

If strPath = "False" Then
    MgsBox "キャンセルされました。"
Else
    MgsBox "選択したファイルのパス：" & strPath   
End If


'' ======================================
'' フォルダ選択ダイアログ
'' ======================================
 Dim objFolderDlg As Office.FileDialog   ' ダイアログオブジェクト

'  ダイアログオブジェクトの取得
Set objFolderDlg = Application.FileDialog(msoFileDialogFolderPicker)

' ダイアログの初期値をセット
objFolderDlg.InitialFileName = "C:\temp"

If objFolderDlg.Show() = True Then
    MgsBox "キャンセルされました。"
Else
    MgsBox "選択したフォルダのパス：" & objFolderDlg.SelectedItems(1) 
End If

'' ======================================
'' 数値チェック関数
'' ======================================
Private Function IsNumber(ByVal p_strValue As String) As Boolean
    Dim bolResult As Boolean
    Dim i As Integer
   
    bolResult = True

    If Len(p_strValue) = 0 Then
        bolResult = False
    Else
        For i = 1 To Len(p_strValue)
            If Not Mid(p_strValue, i, 1) Like "[0-9]" Then
                bolResult = False
                Exit For
            End If
        Next
    End If

    IsNumber = bolResult
End Function

'' ======================================
'' 画面の自動更新、自動計算の停止・再開
'' ======================================
' 画面の更新停止
Application.ScreenUpdating = False

' 自動計算停止
Application.Calculation = xlManual

' 自動計算実行
Calculate

' 自動計算再開
Application.Calculation = xlAutomatic

' 画面の更新再開
Application.ScreenUpdating = True