Top> 部品（その他）
エラーを無視（エラーメッセージをださない）
シートが存在しないとき削除
Dim sname As String
Dim i As Long
On Error Resume Next
rc = MsgBox("現金シートがすべて消えますがよろしいですか", vbYesNo + vbCritical)
If rc = vbYes Then
For i = 5 To 7
sname = "現金" & i & "月"
Application.DisplayAlerts = False
Worksheets(sname).Delete
Application.DisplayAlerts = True
Next
End If
削除の確認メッセージをださない
Application.DisplayAlerts = False
Worksheets(sname).Delete
Application.DisplayAlerts = True
保存の確認メッセージをださない
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
西暦から和暦変換
MsgBox WorksheetFunction.Text(Cells(2, 2), "ggge年")
エクセルの関数をVBAで使う場合
Cells(2, 2) = Application.WorksheetFunction.Substitute(Cells(2, 2), "浅井", "藤本")
ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
複数の条件分岐
Select Case kcode
Case 174, 430
page = 4
Case 177, 427
page = 8
Case 171
page = 12
Case Else
page = 0
End Select
文字列と変数の合体
.AutoFilter Field:=1, Criteria1:="=" & tiku & "*" 'オートフィルタで抽出
Sub ProcedureとFunctionの例
Sub kyou3mae()
Dim tmp As Date
Dim tmp1 As String
tmp = DateAdd("yyyy", -3, Worksheets("開始").Cells(6, 2))
tmp1 = Year(tmp) & "/" & Month(tmp)
Worksheets("開始").Cells(6, 4) = tmp1
End Sub
Function kyoukara3nenmae(kyou As Date)
Dim tmp As Date
Dim tmp1 As String
tmp = DateAdd("yyyy", -3, kyou)
tmp1 = Year(tmp) & "/" & Month(tmp)
kyoukara3nenmae = tmp1
End Function
所得税の計算
'別表１の計算
Select Case 社会保険控除後の給与
Case Is < 135417
給与所得控除後 = 54167
Case Is < 150000
給与所得控除後 = 社会保険控除後の給与 * 0.4
Case Is < 300000
給与所得控除後 = 社会保険控除後の給与 * 0.3 + 15000
Case Is < 550000
給与所得控除後 = 社会保険控除後の給与 * 0.2 + 45000
Case Is <= 833334
給与所得控除後 = 社会保険控除後の給与 * 0.1 + 100000
Case Else
給与所得控除後 = 社会保険控除後の給与 * 0.05 + 141667
End Select
'別表２の計算
'配偶・扶養者を検索（社員番号から）
社員番号 = Worksheets("給料明細VBA").Cells(3, 2)
lastrow = Worksheets("社員").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("社員").Cells(i, 1) = 社員番号 Then
配偶者 = Worksheets("社員").Cells(i, 11)
扶養家族 = Worksheets("社員").Cells(i, 12)
Exit For
End If
Next
別表2 = (配偶者 + 扶養家族 + 1) * 31667
'別表３の計算
課税給与所得 = 給与所得控除後 - 別表2
Select Case 課税給与所得
Case Is < 162501
所得税 = 課税給与所得 * 0.05
Case Is < 275001
所得税 = 課税給与所得 * 0.1 - 8125
Case Is < 579167
所得税 = 課税給与所得 * 0.2 - 35625
Case Is < 750001
所得税 = 課税給与所得 * 0.23 - 53000
Case Is < 1500001
所得税 = 課税給与所得 * 0.33 - 128000
Case Else
所得税 = 課税給与所得 * 0.4 - 233000
End Select
メッセージボックスの改行
MsgBox "資産計=" & Str(流動資産 + 固定資産) & vbCrLf & "負債計=" & Str(流動負債 + 資本) & vbCrLf & "流動資産=" & Str(流動資産)
印刷
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True,IgnorePrintAreas:=False
シートの印刷
Sub 伝票印刷()
Worksheets("売上伝票").PrintOut
End Sub
シートの印刷プレビュー
Sub 伝票印刷()
Worksheets("売上伝票").PrintPreview
End Sub
プリンターの取得
Sub プリンター名取得()
Dim プリンター名 As String
プリンター名 = Application.ActivePrinter
Cells(1, 1) = プリンター名
' Cells(2, 1) = プリンター名
End Sub
プリンターの切り替え
Sub プリンター切り替え()
Dim 通常使うプリンター As String
Dim 今回使うプリンター As String
通常使うプリンター = Application.ActivePrinter
今回使うプリンター = "Canon LBP3300 on Ne03:"
Application.ActivePrinter = 新プリンター名
End Sub
矢印を引くA1形式
Sub 線引き画像A1()
With ActiveSheet.Shapes.AddLine(Range("A1").Left, Range("A1").Top + 10, Range("D1").Left + Range("D1").Width, Range("D1").Top + 10).Line
.ForeColor.RGB = vbRed
.Weight = 2
.EndArrowheadStyle = msoArrowheadTriangle
End With
End Sub
矢印を引くCells形式
Sub 線引き画像cell()
With ActiveSheet.Shapes.AddLine(Cells(3, 1).Left, Cells(3, 1).Top + 10, Cells(3, 4).Left + Cells(3, 4).Width, Cells(3, 4).Top + 10).Line
.ForeColor.RGB = vbBlue
.Weight = 2
.EndArrowheadStyle = msoArrowheadTriangle
End With
End Sub
線の画像のみ削除
Sub 画像削除()
Dim 画像 As Shape
For Each 画像 In ActiveSheet.Shapes
'1-オートシェイプ 9-線
If 画像.Type = 9 Then
画像.Delete
End If
Next
End Sub
オブジェクトの削除1
With ActiveSheet
For i = .Shapes.Count To 1 Step -1
If .Shapes(i).Type = msoTextBox Then .Shapes(i).Delete
Next i
End With
オブジェクトの削除2（テキストボックスのみ）
Dim ole As OLEObject
With ActiveSheet
.TextBoxes.Delete
End With
全てのオブジェクトの削除
Dim tobj As Shape
For Each tobj In Worksheets("全員").Shapes
tobj.Delete
Next
前年累計対比（入力されている月を判断）
Sub zennetaihi()
Dim kotosi As Long
Dim zennen As Long
Dim i As Long
Dim x As Long
For i = 2 To 13
If Cells(4, i) = "" Then
x = i - 1
Exit For
End If
Next
kotosi = 0
zennen = 0
For i = 2 To x
kotosi = kotosi + Cells(4, i)
zennen = zennen + Cells(3, i)
Next
Cells(5, 14) = kotosi / zennen
End Sub
メッセージボックスの確認
Dim rc As Long
rc = MsgBox("削除してもよろしいか", vbYesNo + vbExclamation)
If rc = vbYes Then
MsgBox "削除されました", vbInformation
End If
エラー発生時飛ばす
Sub keisan()
On Error GoTo error
Cells(1, 1) = Cells(1, 2) / Cells(1, 3)
Exit Sub
error: MsgBox "エラーが発生しました"
End Sub
エラーを無視して次を実行
Sub keisan1()
On Error Resume Next
Cells(1, 1) = Cells(1, 2) / Cells(1, 3)
Cells(2, 1) = Cells(1, 2) * Cells(1, 3)
End Sub
