Excel VBA ノート(サンプルコード)

Hide Tamura の Excel VBA ノート

Excel-VBA ファイル名から拡張子を取った文字列を取得する(拡張子の文字数は不明)

VBAProject --> 標準モジュール --> ModuleXX

Sub Sample()
    
    Dim strFileNameA As String
    
    Const strFileNameB As String = "TestFile.xlsm"
    
    'TestFile.xlsmから、.xlsm をとる
    
    strFileNameA = Left(strFileNameB, InStrRev(strFileNameB, ".") - 1)
    
    MsgBox strFileNameA

End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA ワークブックの変更を保存しないでブックを閉じる(保存確認のメッセージなし)

VBAProject --> Microsoft Excel Objects --> ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    'ワークブックの変更がなかったことにする(既に保存済みにする)
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    'または変更を保存せずに閉じる
    ActiveWorkbook.Close Savechanges:=False

End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA ユーザーフォームを表示する時の位置を画面の左上隅にする

VBAProject --> 標準モジュール --> ModuleXX

Sub UserForm7Show()
        
    'ユーザーフォームの表示位置を画面の左上隅の位置にする
    UserForm7.StartUpPosition = 3

    UserForm7.Show
    
    VBA.AppActivate "Microsoft Excel"
    
End Sub


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA マルチページのタブを選択した状態でユーザーフォームを開く

VBAProject --> 標準モジュール --> ModuleXX

Sub UserForm7Show()
        
    '左から二つ目のタブを選択状態にする
    UserForm7.MultiPage1.Value = 1

    UserForm7.Show
    
    VBA.AppActivate "Microsoft Excel"
    
End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA CSVファイルをTXTファイルに変換し高速に開く

高速化する為に、CSVファイルをTXTファイルに変換してからオープンします。

CSVファイルの一行目の書き出しが、ID の場合「Excelは、'ファイル名'がSYLK ファイルであることを・・・」というエラーが発生します。これは、CSVファイルをExcelがSYLKファイルと認識してしまう為らしく、テキストエディタでCSVファイルを開き、一時的に変更してください。

VBAProject --> 標準モジュール --> ModuleXX 

Private Sub CommandButton1_Click()
'CSV読込

    Dim myPath As String, mySheet As String
    Dim myCSVFile As Variant, myTXTFile As Variant
    Dim strThisFileName As String, strOpenFileName As String
    Dim lngFieldCount As Long, lngRecordCount As Long
    
    'ファイル間を移動するので、このExcelファイル名を覚えておく
    strThisFileName = ThisWorkbook.Name
    
    '★データのフィールド数を設定
    lngFieldCount = 17
    
    'このファイルのパスを取得
    myPath = ThisWorkbook.Path
    
    '現在のアクティブシート名を覚えておく
    mySheet = ActiveSheet.Name
    
    'カレントドライブ、カレントフォルダの移動
    ChDrive myPath
    ChDir myPath

    'CSVファイルを選択し、ファイル名を取得
    myCSVFile = Application.GetOpenFilename("CSVファイル (*.csv), *.csv")
    
    '選択されずにキャンセルされた場合
    If myCSVFile = False Then Exit Sub
    
    Application.ScreenUpdating = False
    
    'CSVファイルからTXTファイルに変換(パスが付いたファイル名)
    myTXTFile = Left(myCSVFile, Len(myCSVFile) - 4) & ".txt"
    Name myCSVFile As myTXTFile
    
    '変換したテキストファイルを開く
    Workbooks.OpenText Filename:=myTXTFile, DataType:=xlDelimited, comma:=True
    
    '開いたテキストファイル名
    strOpenFileName = ActiveWorkbook.Name
    
    '貼り付け先のデータをクリア
    With Workbooks(strThisFileName).Sheets(mySheet).Range("B11")
        .Resize(.CurrentRegion.Rows.Count, lngFieldCount).ClearContents
    End With
    
    'CSVファイルのレコード数
    lngRecordCount = Workbooks(strOpenFileName).Sheets(1).Cells(1).CurrentRegion.Rows.Count
    
    'CSVファイルをコピー
    Workbooks(strOpenFileName).Sheets(1).Cells(1).Resize(lngRecordCount, lngFieldCount).Copy
    
    '値貼り付け
    Workbooks(strThisFileName).Sheets(mySheet).Range("B11").PasteSpecial Paste:=xlPasteValues
    
    'コピーモードを解除(重要)
    Application.CutCopyMode = False
    
    'テキストファイルを閉じる
    Workbooks(strOpenFileName).Close savechanges:=False
    
    'テキストファイル名をCSVファイル名に戻しておく
    Name myTXTFile As myCSVFile
    
    Range("B11").Select
    
    Application.ScreenUpdating = True
    
End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA 入力データの最終行と最終列を求める

 VBAProject --> 標準モジュール --> ModuleXX 

Sub Sample()

    Dim r As Long, c As Long
    Dim lngLastRow As Long, lngLastCol As Long
    
    'Excelの行数
    r = Application.Rows.Count
    
    'Excelの列数
    c = Application.Columns.Count
    
    'A列データの最終行
    lngLastRow = ActiveSheet.Cells(r, "A").End(xlUp).Row

    '1行目データの最終列
    lngLastCol = ActiveSheet.Cells(1, c).End(xlToLeft).Column

    MsgBox "A列データの最終行: " & lngLastRow & vbCrLf & _
            "1行目データの最終列: " & lngLastCol

End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA コンボボックスに月を設定

VBAProject --> フォーム --> UserFormXX

ComboBox1のStyleプロパティ = 2-fmStyleDropDownList
(入力不可、リスト選択のみ)

Private Sub UserForm_Initialize()
    Dim i As Long
    
    For i = 1 To 12
        ComboBox1.AddItem i & "月"
    Next i
    
    '1月を表示
    ComboBox1.ListIndex = 0
    
End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA ユーザーフォームのクローズボックスを消す

32bit 以外ではエラーになるので、最近は使わない

最近は、こちらで対応する事が多い
ユーザーフォームのクローズボタン[×]を無効にする

VBAProject --> 標準モジュール --> ModuleXX

Public Declare Function FindWindow Lib "user32" _
      Alias "FindWindowA" (ByVal lpClassName As String, _
      ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib "user32" _
      Alias "GetWindowLongA" (ByVal hwnd As Long, _
      ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" _
      Alias "SetWindowLongA" (ByVal hwnd As Long, _
      ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" _
      (ByVal hwnd As Long) As Long
Public Const GWL_STYLE = -16&
Public Const WS_SYSMENU = &H80000


VBAProject --> フォーム --> UserFormXX

Private Sub UserForm_Activate()

    Dim hwnd As Long
    Dim lngs As Long
    Dim rc As Long
    
    hwnd = FindWindow("ThunderDFrame", Me.Caption)
    lngs = GetWindowLong(hwnd, GWL_STYLE)
    rc = SetWindowLong(hwnd, GWL_STYLE, lngs Xor WS_SYSMENU)
    rc = DrawMenuBar(hwnd)

End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA ユーザーフォームを一定時間表示して閉じる

VBAProject --> 標準モジュール --> ModuleXX

Sub Sample()

    UserForm1.Show
    
End Sub


VBAProject --> フォーム --> UserFormXX

Private Sub UserForm_Activate()
    
    Dim 指定時刻 As String

    '現在時刻より3秒
    指定時刻 = Now + TimeValue("00:00:03")
    
    Application.Wait (指定時刻)
    
    Unload Me

End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Excel-VBA ブックを自動保存しない(自動回復は行わない)

保存時間が長くかかるファイルの場合、一定時間間隔で自動で行われる保存を止めたいことがある。

VBAProject --> 標準モジュール --> ModuleXX

Sub Sample0120412()

    'Excelブックの自動保存を行わない
    ActiveWorkbook.EnableAutoRecover = False
    
End Sub


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 
Excel VBA ノートについて(注意事項)
このExcel VBA ノートは、Hide Tamura の個人的なVBAノートです。プログラムを再利用したり、コピペで入力の手間を省く為に作ったネット上のノートです。
その為、詳しい解説は書いておりません。エラー等のトラブルには責任は負いません。利用者の環境に合わせて書き換えてご利用ください。

記事をうまくカテゴリー分け出来ていない事が多いので、↓下の記事検索で、キーワード検索してください。
記事検索


ExcelVBAマクロ作成代行


様々な企業、会計事務所、病院からマクロ作成代行を請け負っております。マクロ作成でお役に立てたら嬉しいです。まずはお気軽にご相談ください。
ExcelVBA教室
最新記事
Excel VBA おすすめ書籍
楽しくVBAを学びたければ、一押しは「大村あつし」さんの書いたVBA書籍です。とにかく分かりやすく、VBAが好きになると思います。



土屋和人さんの Excel VBA パーフェクトマスターは、これ一冊で広く学べる良い本です。全て読めば、かなり詳しくなります。辞書のように調べやすいので、困った時に助かります。


Excel VBA 担当 Hide Tamura

Excel95? マクロシートがあった頃からExcelVBAを独学で利用しています。現在は、様々な企業様からVBAによる業務効率UPの為のお仕事を頂いております。既にお使いになっているファイルにVBAを利用することで、作業が楽になったり、時間も大幅に短縮されたなど、大変喜ばれています。

■VBA Expert
VBA Expert Standard Crown
ExcelVBA Standard(Odyssey)
Access VBA Standard(Odyssey)
Excel2002 VBA Standard(日本VBA協会)
■MICROSOFT OFFICE USER SPECIALIST
Microsoft Excel version2002 Expert
Microsoft Excel version2002
Excelで作る経営計画
Excelで利益計画を立てましょう!会社にいくらの利益が必要で、その為の売上高は?

Excelで作る経営計画
Excel 関数 ノート
Excel関数を中心に、Excelの便利機能や、意外としらない使い方など書いていきます。

Excel 関数 ノート
Access VBAノート
Hide Tamura の個人的なVBAノートです。

頻繁に使うVBAコードなどを記録しコピペして使う為に作りました。お役に立てるようでしたら、お使いください。

Access VBAノート
アクセスカウンター