| No | 項目 | 内容 | 例文 | 記事 |
| 1 | 開く | ファイルを指定してブックを開く | Workbooks.Open Filename:="C:\tst\tstBook1.xls" | |
| 2 | 開く | ブックを読み取り専用で開く | Workbooks.Open FileName:="c:\test.xls" , ReadOnly:=True | |
| 3 | 開く | ブックをリンクの更新をしないで開く | Workbooks.Open Filename:="C:\tst\tstBook1.xls", UpdateLinks:=0 | |
| 4 | 開く | ファィルを開くダイアログからブックを開く | myfil = Application.GetOpenFilename("Excelファイル(*.xls),*.xls") | |
| 5 |
保存 |
アクティブブックを名前を付けて保存する (Excel2003と2007を同じ記述) |
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & _ "\tstBook2.xls", FileFormat:=xlWorkbookNormal |
|
| 6 | 保存 | ワークブック"Book1.xls"を保存しないで閉じる | Workbooks("Book1").Close SaveChanges:=False | |
| 7 | 保存 | ワークブック"Book1.xls"を保存して閉じる | Workbooks("Book1").Close SaveChanges:=True | |
| 8 | 保存 | アクティブブックを上書き保存して | ActiveWorkbook.Save | |
| 9 | 閉じる | アクティブブックを閉じる | ActiveWorkbook.Close | |
| 10 | 閉じる | 指定したブックを閉じる | Workbooks("tstBook1.xls").Close | |
| 11 | 閉じる | 開かれているすべてのブックを閉じる | Workbooks.Close | |
| 12 | 閉じる | 閉じると共にExcelを終了する | Application.Quit | |
| 13 | 閉じる | 確認メッセージを表示しないでブックを閉じる | Application.DisplayAlerts = False ・・・・・・ | [ブック1]マクロ |
| 14 | 新ブック | ワークブックを新規に作成する | Workbooks.Add | |
| 15 | 参照 | 指定ブックをアクティブにする | Workbooks("Book1.xls").Activate | |
| 16 | 参照 | インデックス指定でアクティブにする | Workbooks(1).Activate | |
| 17 | 参照 | マクロ入りのブックをアクティブにする | ThisWorkbook.Activate | |
| 18 | 設定 | ファイルのアクセスの変更読み取り専用 | ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly | |
| 19 | 設定 | ファイルのアクセスの変更読み書き可能に設定 | ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite | |
| 20 | 情報取得 | ブックのファイル形式を取得する | Msgbox ActiveWorkbook.FileFormat | |
| 21 | 情報取得 | 読み取り専用か調べる | Msgbox ActiveWorkbook.ReadOnly | |
| 22 | 情報取得 | 読み取り専用か調べる（開いてないブック） | Msgbox GetAttr("C:\tst\tstBook1.xls") And vbReadOnly | |
| 23 | 情報取得 | Windowsコレクション数量 | MsgBox Windows.Count | |
| 24 | 情報取得 | 開いているウインドウズのコレクションチェック | For Each file_name In Windows ・・・・ | [ブック2]マクロ |
Subブック1()
Application.DisplayAlerts = False
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
Application.DisplayAlerts = False
End Sub
|
Subブック2()
Dim i As Integer, mydat As String, b_name As Object
For Each b_name In Windows
i = i + 1
mydat = mydat & " (" & i & ")" & b_name.Caption
Next
MsgBox mydat
End Sub
|
Const fil2a As String = "小文字.xls"Subブック2a()
phn = ThisWorkbook.Path 'このマクロ同じフォルダのブック
fila = 0
For Each file_name In Windows
If file_name.Caption = fil2a Then
Windows(fil2a).Activate
fila = 1
End If
Next
If fila = 0 Then
Workbooks.Open Filename:=phn & "\" & fil2a
End Sub
|
| ※上記は指定のブックは開いているかチェックし、開いていない場合は開く。 |
Sub 保存1_1()
Workbooks.Add
If CSng(Application.Version) > 11 Then
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & _
"\tstBook.xls", FileFormat:=xlExcel8
Else
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\tstBook.xls"
End If
ActiveWorkbook.Close
End Sub
|
Sub 保存1_2()
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & _
"\tstBook.xls", FileFormat:=xlWorkbookNormal
End Sub
|
Sub 保存1_3()
ActiveWorkbook.SaveAs Filename:="C:\tst\tstBook2.csv", _
FileFormat:=xlCSV, CreateBackup:=False
End Sub
|
Sub 保存2_1() |
Sub 保存2_2()
If ActiveWorkbook.Saved = False Then
ActiveWorkbook.Save
End If
ActiveWorkbook.Close
End Sub
---------------------------------------------------------
Sub 保存2_2a()
ActiveWorkbook.Close SaveChanges:=True
End Sub
|
Sub 保存2_3()
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub
---------------------------------------------------------
Sub 保存2_3a()
ActiveWorkbook.Close SaveChanges:=False
End Sub
|
Sub 保存2_4()
ThisWorkbook.Close SaveChanges:=False
End Sub
|
Sub 小文字1()
Dim fal As String, fff As String, fname As String
Dim kname As String, pth As String, moz As String
Dim su As Integer
fal = "すべてのファイル(*.*),*.*"
fff = Application.GetOpenFilename(fal, , Title:="ファイル指定") 'ファイル指定
If fff = "False" Then
MsgBox "ファイルを指定して下さい"
Exit Sub
End If
fname = Dir(fff)
kname = Mid(fname, InStrRev(fname, "."))
pth = Replace(fff, fname, "")
moz = Dir(pth & "*" & kname)
Name pth & moz As pth & StrConv(moz, 2)
Do
moz = Dir()
If moz = "" Then Exit Do
Name pth & moz As pth & StrConv(moz, 2)
su = su + 1
Loop Until moz = ""
MsgBox su + 1 & "個の" & kname & " ファイルを小文字に変換しました"
End Sub
|
Dim pth1 As String, su As Integer
Sub 小文字2()
Dim myobj As Object, moz As String
su = 0: pth1 = ""
Columns("B:B").Clear
Set myobj = CreateObject("Shell.Application") _
.BrowseForFolder(0, "フォルダを選択してください", &H1)
If myobj Is Nothing Then
Exit Sub
End If
pth1 = myobj.Self.path
Set myobj = Nothing
Call 小文字2a
MsgBox su & "個のファイルを小文字に変換しました。"
End Sub
--------------------------------------------------------
Sub 小文字2a()
Dim pth As String, moz As String, myobj As Object, folder As Object
pth = pth1 & "\"
moz = Dir(pth & "*" & "*")
Name pth & moz As pth & LCase(moz)
su = su + 1
Worksheets("sheet1").Cells(su + 10, 2).Value = pth & moz
Do Until moz = ""
moz = Dir()
If moz = "" Then Exit Do
Name pth & moz As pth & LCase(moz)
su = su + 1
Worksheets("sheet1").Cells(su + 10, 2).Value = pth & moz
Loop
サブフォルダ
Set myobj = CreateObject("Scripting.FileSystemObject")
For Each folder In myobj.GetFolder(pth1).SubFolders
pth1 = folder
Call 小文字2a
Next folder
End Sub
|
'サブフォルダ
With CreateObject("Scripting.FileSystemObject")
For Each folder In .GetFolder(pth1).SubFolders
pth1 = folder
Call 小文字2b
Next folder
End With
|
Dim ffg As New Scripting.FileSystemObject
Dim fol As Scripting.folder
サブフォルダ
Set fol = ffg.GetFolder(pth1)
For Each folder In fol.SubFolders
pth1 = folder
Call 小文字3a
Next folder
|
Name pth & moz As pth & StrConv(moz, 2)
この行を以下に変更
If Left(moz, 1) = "図" Then
moz1 = "画面" & Mid(moz, 2)
Name pth & moz As pth & moz1
su = su + 1
End If
|
