Top> 部品(その他)

VBA通信教材申込み

VBA課題解決型実践塾セミナー内容

申込 ヤフーショッピング

部品(その他)

エラーを無視(エラーメッセージをださない)

  シートが存在しないとき削除
    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

所得税の計算

  '別表1の計算
  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
  '別表2の計算
  '配偶・扶養者を検索(社員番号から)
    社員番号 = 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
  '別表3の計算
    課税給与所得 = 給与所得控除後 - 別表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

塾長あいさつ
基本方針(考え方)
通信教育内容
課題解決セミナー内容
初心者基礎コース内容
カリキュラム・料金
案内地図・各種リンク
問合せ・申込み
アベノ塾
システムの内製化
アサイコンピュータACS
応用部品集(有料)
販売管理(事例)
財務管理(事例)
顧客管理(事例)
見積もり(事例)
給与(事例)
介護(事例)
ゴースト暗算(事例)
部品集(部品の基礎)
部品集(シート関連)
部品集(データベース)
部品集(セル関連)
部品集(関数)
部品集(フォーム関連)
部品集(ブック関連)
部品集(その他)
変数の勉強
繰り返しと条件文
マスター登録.訂正.削除
フォルダー内のファイル
項目をシート名で作成
ブックの操作
CSVファイルの取り込み
呼び出し元・先
商品マスター検索
エクセル関数をVBAで
エクセル関数を使う
よくつかうプログラム
販売管理(ソース)
財務管理(ソース)
給与管理(概要・画面)
見積もり(概要・画面)
工程管理(概要・画面)
原価管理(概要・画面)