With .Cells(1, 1)
.Value = "value"
.Font.Size = 26
.Font.Bold = True
.Font.color = red
End With
STEP
非表示セルを再表示する。
'非表示行列を再表示する。
With St.Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
STEP
セルの結合がされていたら結合解除する。
With St.Cells(r, c)
If .MergeCells Then
.MergeArea.UnMerge
End If
End With
STEP
全行を検索して特定のキーワードがあったら行を削除（下から上へ判定）
Dim i As Long
For i = 最終行 To 開始行 Step -1
With St.Cells(i, 1)
If .Value = "削除対象キーワード" Then
.EntireRow.Delete
End If
End With
Next
STEP
カレントリージョンの取得
Dim myRegion As Variant
myRegion = Range("A1").CurrentRegion
STEP
カレントリージョンを取得して、列方向に1列ずつ評価
Dim myRegion As Variant
myRegion = Range("A1").CurrentRegion
For i = LBound(myRegion , 2) To UBound(myRegion,2)
If IsDate(myRegion (1, i)) = True Then
'処理
End If
Next
STEP
最終行と最終列（非推奨）
Dim r As Long 'collumn
Dim c As Long 'row
With ActiveSheet.Cells(1, 1)
r = .End(xlDown).Row
c = .End(xlToRight).Column
End With
on error resume next
Dim str As String
Str = Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & ThisWorkbook.Name
Dim savename As String
savename = InputBox("ファイル名を入力してください。", Default:=str)
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & savename
STEP
Excelファイルを開く、処理、閉じる
STEP
新規ファイルを開きます。
Dim filename As String
filename = "C:\Users\user\Desktop\Book1.xlsx"
Dim Book As Workbook
Set Book = Excel.Workbooks.Open(filename)
'処理
Book.Close savechanges:=True
Set Book = Nothing
▲Bookを開いて処理をして保存して閉じる。
STEP
ファイルダイアログを表示してユーザーに開くファイルを選択してもらいファイルを開きます。
'ファイルをピックさせる。
Application.ScreenUpdating = False
On Error Resume Next
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Show
new_book_name = .SelectedItems(1)
End With
'ファイル選択失敗したときの処理
If Err.Number <> 0 Then
MsgBox "ErrNum" & Err.Number & vbNewLine & Err.Description
Debug.Print Err.Description
Err.Clear
Exit Sub
End If
Application.ScreenUpdating = True
処理系
Select Case
STEP
Select Case
Select Case .Cells(r, c).Value
Case 0
処理
Case Is <= 3200 '32pcs以上取得する
処理
Case 3201 To 35000 '125pcs以上取得する
処理
Case Is >= 35001
処理
End Select
if then
STEP
If Cells(8, 1).Value = "" Then
Rows(8).Delete
End If
エラー処理・例外処理
STEP
エラーが発生しても停止せずに処理を続けます。（例外処理）
On Error Resume Next
処理
On Error GoTo 0
エラーが発生したときにユーザーフレンドリーな画面を表示させるときや、例外処理する時に使います。
STEP
エラーメッセージを表示させてマクロを強制終了します。
On Error Resume Next
'エラー処理
If Err.Number <> 0 Then
MsgBox Err.Number Err.Description & "エラーが発生したためマクロを終了します。頻発する場合はエラーメッセージとエラー番号を管理者に伝えてください。"
Err.Clear
Exit Sub
End If
On Error Resume Next
Do
If Err.Number = 1004 Then ’シート名称重複エラー
Err.Clear
End If
Worksheets(Worksheets.Count).Name = _
InputBox("シート名を命名してください。", _
Default:="new_sheet")
Loop Until Err.Number <> 1004
'エラー処理
On Error Resume Next
If Err.Number <> 0 Then
MsgBox Err.Description & "マクロを終了します。"
Err.Clear
Exit Sub
End If
If dic.Exists(key) = False Then
dic.Add key, value
Debug.Print dic.Item(value)
Else
Debug.Print value & "は登録済みのためスキップしました"
End If
STEP
辞書から全部取り出す。
‘■「キー」を取り出す
For i = 0 To dic.Count – 1
Debug.Print dic.Keys(i)
Next i
‘■両方同時に取り出す(キー → アイテム)
Dim Var As Variant
For Each Var In dic
Debug.Print Var & “,” & dic.Item(Var)
Next Var
STEP
辞書から1個とりだす。
Excel VBAからOutlook送信
STEP
メールテンプレート.oftファイルを使ってメール送信する。
Sub メール作成(AttachFile As String)
'実行時バインディングで動作します。
Dim MAILTEMPLETE As String
On Error Resume Next
MAILTEMPLETE = UserForm1.TxBx_メールテンプレフルネーム.Text
If MAILTEMPLETE = "" Then
MsgBox ("メールテンプレートが見つけられません。設定を行ってから実行してください。")
Exit Sub
End If
Dim oApp As Object 'Outlook.Application 'Outlookのオブジェクト
Dim objMAIL As Object ' Outlook.MailItem 'Object 'メールのオブジェクト
Dim myNameSpace As Object 'MAPI用
Dim myFolder As Object 'MAPI用
Dim BodyString As String
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
Set oApp = CreateObject("Outlook.Application")
End If
Set objMAIL = oApp.CreateItemFromTemplate(MAILTEMPLETE)
If Err.Number <> 0 Then
MsgBox ("メール作成ができません。oft形式のテンプレートファイルのフルパスの設定を確認してください。")
Err.Clear
End If
Set myNameSpace = oApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(6) '下記とやってることは同じ。実行時バインディングだと定数が使えないので数字で指定している。
'Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
objMAIL.Attachments.Add AttachFile
BodyString = "・" & objMAIL.Attachments.Item(1).Filename & vbNewLine
objMAIL.Subject = "MAILTEMPLETE" & Format(Date, "(yyyy/mm/dd(aaa))")
objMAIL.htmlBody = Replace(objMAIL.htmlBody, "◆置換◆", BodyString)
objMAIL.Display
Set myFolder = Nothing
Set myNameSpace = Nothing
Set objMAIL = Nothing
Set oApp = Nothing
End Sub
' リストボックスに、ブックに存在するすべてのワークシート名をリストする。
Private Sub UserForm_Initialize()
Dim st As Worksheet
For Each st In Worksheets
Me.ListBox1.AddItem st.Name
Next
End Sub
STEP
ユーザーフォームをEscキーで閉じれるようにする。
Private Sub UserForm_Activate()
Application.OnKey "{ESC}", "UserFormClose"
end sub
Sub UserFormClose()
Unload UserForm1
End Sub
じょじお
