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

Hide Tamura の Excel VBA ノート

Excel-VBA 問題・トラブル・バグ 2014年12月10日のWindows Update でActiveXオブジェクトが挿入できない。コマンドボタンが押せない。MSForms.exdを削除! ( MSForms.exd KB2596927 KB2553154 KB2726958 )

2014年12月10日のWindows Update の後、ActiveXオブジェクトが使えなくなった。

「オブジェクトが挿入できません」 と表示されたり、コマンドボタンが押せないなどのトラブルが発生しました。

対応方法を調べ、トラブルを回避できました。私の行った方法を2つ書いておきます。
方法1がダメだった時には、方法2で使えるようになりました。
自己責任で試してみてくださいね。(*^_^*)

方法1:

マイクロソフトのホームページに修正方法が掲載されました。
http://support2.microsoft.com/kb/3025036/ja

実際にやってみました。Temp から、MSForms.exd というファイルを消すという方法になります。

まずは、
スタート>コンピューター>OS(C:)>ユーザー>(ユーザー名)>AppDAta>Local>Temp
の画面に移動します。


スタートから、「コンピューター」を選択します。(下図) 

s


「 OS(C:) 」を選択します。(下図) 

2


「 ユーザー 」を選択します。(下図) 

3


「ユーザー名」を選択(下図) 注意: Hide は私の名前ですので、あなたのPCには無いはず。(^_^)

4


「AppData」を選択(下図)

5


「 Local 」を選択(下図)

6


「Temp」を選択(下図)

7

これで、スタートから、
コンピューター>OS(C:)>ユーザー>(ユーザー名)>AppDAta>Local>Temp
まで、辿り着きました。

右上に、Tempの検索窓があります。ここに、MSFORMS.exd というファイル名を入力して検索します。

8


MSForms.exd ファイルが検索されました。このファイルを削除します。(下図)

下の例では、二つのファイルを検索されました。キーボードのCtrlキーを押しながら選択すると、複数のファイルを同時に選択できます。ファイルが選択された状態で、マウスの右クリックを押し、表示されたメニュから、「削除」を選択実行します。

10

そして、最後に、パソコンの再起動をかけます。


これで、ちゃんと動くようになりました。


それでも、動かなかった時は、方法2で使えるようになりました。

方法2:

☆この方法でも動くようになりましたが、方法1の方が良いと思います。

Windows のスタートから、次のように選択します。

スタート>コントールパネル>プログラム>インストールされた更新プログラムを表示

アップデートの一覧から

Office2007 の場合は KB2596927
Office2010 の場合は KB2553154
Office2013 の場合は KB2726958

( 表示例: Security Update for Microsoft Office 2010 (KB2553154) 32-Bit Edition )

というファイルをアンインストールすると使用可能になるようです。

私の場合は、Office2010 と 2013 の両方がパソコンに共存していますが、Office2010 のファイルだけが見つかりました。 これを削除して使用可能になりました。

「インストールされた更新プログラムを表示」で表示されるファイルは多数ありますが、画面の右上に、検索窓があり、ファイル名で検索が可能です。

後日のWindows Update で再びこの削除したファイルがインストールされてしまいました。なので、上記の方法1が良いと思います。

以上です。 




Excel-VBA ユーザーフォームを「Esc」キーで閉じる CommandButton CancelプロパティをTrue

ユーザーフォームをキーボードの「Esc」キーで閉じるには、

ユーザーフォームに CommandButton を使用して、「閉じる」ボタンを作ります。

このCommandButton のプログラムに、Unload me と書いておきます。

Private Sub CommandButton1_Click()
    Unload Me
End Sub

このボタンで、その他の処理を行う必要があれば、最後の行に書いてください。

この CommandButton のプロパティで Cancel を True にします。

これだけです。

cancel






Excel-VBA セルの値が文字列かどうかの判定 TypeName

Sub Sample6()

    Dim i As Long
    
    For i = 1 To 5
    
        If TypeName(Cells(i, "A").Value) = "String" Then
        
            MsgBox "このセルのデータは文字列です"
        
        End If
    
    Next i
    
End Sub

注意: TypeName(Cells(i, "A").Value) = "String"
.value は省略してはいけない。
StringのSは大文字でなくてはいけない。TypeNameの結果のまま使うこと。

その他のタイプを判定したい場合は、TypeName(Cells(i, "A").Value) の結果をイコールで結んで判定すれば良い。






 

★Excel 2013対応 Excel-VBA ウィンドウ状態を設定 WindowState , DisplayFullScreen

シングルステップでプログラムを動かして、変化を確認してください。

'Excel2013以上のバージョンでテストしてください
'Excel2013では、アプリケーションウインドウの中でブックがxlNormalサイズになることはない
'Excelブックのウインドウとアプリケーションのウインドウは一致
Private Sub Macro2()
    
    'アプリケーションウインドウを 最小、最大、元のサイズ
    Application.WindowState = xlNormal
    Application.WindowState = xlMinimized
    Application.WindowState = xlMaximized
    
    'Excel2013では、アプリケーションウインドウとほぼ同じ動き
    ActiveWindow.WindowState = xlNormal
    ActiveWindow.WindowState = xlMinimized
    ActiveWindow.WindowState = xlMaximized
    
    'ウインドウの全画面表示、元のサイズ
    Application.DisplayFullScreen = True
    Application.WindowState = xlNormal

End Sub

'Excel2010以下のバージョンでテストしてください
Private Sub Macro1()
    
    'アプリケーションウインドウを 最小、最大、元のサイズ
    Application.WindowState = xlNormal
    Application.WindowState = xlMinimized
    Application.WindowState = xlMaximized
    
    'ウインドウ内のブックを 最大、最小、元のサイズ
    ActiveWindow.WindowState = xlMaximized
    ActiveWindow.WindowState = xlMinimized
    ActiveWindow.WindowState = xlNormal
    
    'ウインドウの全画面表示、元のサイズ
    Application.DisplayFullScreen = True
    Application.WindowState = xlNormal

End Sub


Excel2013 と Excel2010 以下のバージョンで、同じようにアプリケーションウインドウをフローティング(xlNormal)状態にし、アプリケーションウインドウの中でブックを最大表示にしたい場合は、
ブックを最大にした後、アプリケーションをノーマル(xlNormal)状態にする

Sub Macro3()

    ActiveWindow.WindowState = xlMaximized
    Application.WindowState = xlNormal

End Sub
 

Microsoft Office ブログランキングへ


Excel-VBA ウインドウのサイズと表示位置の設定 Application.width .Height .Top .Left

Sub WindowSet()

    With Application
        .WindowState = xlNormal
        If .Width < 1000 Then .Width = 1000
        If .Height < 700 Then .Height = 700
        .Top = 20
        .Left = 50
    End With

End Sub

 

Excel-VBA データ集計、可視セルをコピー Selection.Subtotal Selection.SpecialCells(xlCellTypeVisible)

Function データ加工_後半()

    '集計加工シートから集計Workシートにコピーして、
    '並べ替えをして、集計して、集計シートに転送している

    Dim r As Long, lngLastRow As Long, lngPasteRow As Long
    Dim i As Long
    Dim KakouSheet As String, SyukeiSheet As String, SyukeiWorkSheet As String
    Dim lngTuki As Long, TargetCol As Long
    Dim strTekiyou As String
    Dim lngGetTekiyou As Long
    
    '加工済みシート
    KakouSheet = ActiveSheet.Name
        
    '----- 設定 開始 -----
    
    '集計処理に使うシート
    SyukeiWorkSheet = "集計WORK"
    
    '集計結果に使うシート
    SyukeiSheet = "集計"
    
    '貼りつけ行を指定
    lngPasteRow = Cells(1, "B").End(xlDown).Offset(1).Row
    
    '----- 設定 終了 -----
        
    Application.ScreenUpdating = False
    
    r = Application.Rows.Count

    '##############
    '#  並べ替え
    '##############
    
    Sheets(SyukeiWorkSheet).Cells.ClearContents
    Sheets(KakouSheet).Activate
    
    Cells(lngPasteRow - 1, "B").Select
    Selection.CurrentRegion.Copy
    
    Sheets(SyukeiWorkSheet).Select
    Cells(lngPasteRow - 1, "B").Select
    ActiveSheet.Paste
    
    Columns("D:E").Select
    Selection.ClearContents
    
    Cells(lngPasteRow - 1, "B").Select
    Selection.CurrentRegion.Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("B6"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin
    
    '##############
    '#   集 計
    '##############

    'シート名から月を求める
    lngTuki = Val(KakouSheet)
    
    '集計シートのターゲット行を求める
    TargetCol = 2 + (lngTuki - 1) * 5

    Sheets(SyukeiWorkSheet).Activate
    Cells(lngPasteRow - 1, "B").Select
    Selection.CurrentRegion.Select
    
    '集計処理
    Application.CutCopyMode = False
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    
    Sheets(SyukeiWorkSheet).Activate
    Cells(lngPasteRow - 1, "B").Select
    Selection.CurrentRegion.Select
    
    '可視セルのコピー
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
       
    Sheets(SyukeiSheet).Select
    Cells(4, TargetCol).Select
    ActiveSheet.Paste
    Cells(2, TargetCol).Select
    
    Cells.EntireColumn.AutoFit
    
    Sheets(SyukeiWorkSheet).Select
    ActiveSheet.Outline.ShowLevels RowLevels:=3
    
    Cells(lngPasteRow - 1, "B").Select
    Selection.CurrentRegion.Select
    
    Application.CutCopyMode = False
    Selection.RemoveSubtotal
    Range("A1").Select
    
End Function


 

Excel-VBA Excelのクローズボタン「×」を無効にし、プログラム上でブックを閉じたい(終了させたい) Workbook_BeforeClose

起動時に セルのフラグ保存セルをクリア
ここでは、A1セル

Private Sub Workbook_Open()

    Sheets(1).Unprotect
    Sheets(1).Cells(1).ClearContents

End Sub


プログラムの実行ボタンを押したタイミングで、フラグ保存セルに、フラグ「1」を代入
起動直後は、クローズボタン「×」でExcelを閉じられるように、実行ボタンを押したタイミングでフラグを立てる
ここでは、A1セル

Sub Sepia実行()

    Sheets(1).Unprotect
    Sheets(1).Cells(1).Value = 1

End Sub


クローズボタン「×」でExcelを閉じようとすると、フラグが立っているので、メッセージを表示して、クローズをキャンセルする

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    If Sheets(1).Cells(1).Value = 1 Then
    
        MsgBox "メニューの終了ボタンで終わらせてください。", vbExclamation, "終了"
        Cancel = True
        
        Exit Sub
    
    End If

    Application.Quit

End Sub


メニューの終了ボタンでは、フラグをクリアしてからクローズする

Sub 終了処理()
   
    Sheets(1).Unprotect
    Sheets(1).Cells(1).ClearContents

'保存終了
    ThisWorkbook.Close SaveChanges:=True

End Sub



Excel-VBA データをCSVファイル形式に書き出す SaveAs FileFormat:=xlCSV

Sub CSVファイル作成()
    Dim TMPNAME As String, txtTMPNAME As String, myPath As String, szStr As String
    Dim Response As String
    Dim strMySheet As String
    Dim lngLastRow As Long
    
    '余裕を持った使用最大行数
    Const MaxRowsCount As Long = 30000
          
    'このファイルへのPath
    myPath = ThisWorkbook.Path
    
    'このファイルの名前
    TMPNAME = ThisWorkbook.Name
    
    '現在のシート名
    strMySheet = ActiveSheet.Name
    
    'テキスト用ファイルの名前(このファイル名.csv)
    txtTMPNAME = Left(TMPNAME, Len(TMPNAME) - 5) & ".csv"
    
    szStr = szStr & "CSVファイルを作成します" & Chr(13) & Chr(10)
    szStr = szStr & "" & Chr(13) & Chr(10)
    szStr = szStr & "作成場所 → このファイルと同じ階層(フォルダ)" & Chr(13) & Chr(10)
    szStr = szStr & "(" & myPath & ")" & Chr(13) & Chr(13) & Chr(10)
    szStr = szStr & "ファイル名 → " & txtTMPNAME & Chr(13) & Chr(10)
    
    Response = MsgBox(prompt:=szStr, Buttons:=vbOKCancel + vbInformation, Title:="CSVファイルの作成")
    If Response = vbCancel Then Exit Sub
    
    Application.ScreenUpdating = False
    
    'テキスト用ファイルの名前(このファイル名.csv)にPathを含める
    txtTMPNAME = myPath & "\" & txtTMPNAME
    
    'データ最終行を取得
'    ActiveSheet.Select
    lngLastRow = Cells(MaxRowsCount, "D").End(xlUp).Row
    
    '★データ範囲を選択
    Range("D4", Cells(lngLastRow, "I")).Select
    Selection.Copy
    
    'CSV作成用のワークシートを追加
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    
    '追加したシートに貼り付け
    Worksheets(Worksheets.Count).Select
    Range("A1").Select
    ActiveSheet.Paste
    
    lngLastRow = Cells(MaxRowsCount, "A").End(xlUp).Row
    
    
'-----------------------------------------------
    'データがなかった場合 (フィールド名がある場合)
    If lngLastRow = 1 Then
        MsgBox "該当データがありませんでした"

        Worksheets(Worksheets.Count).Select

        Application.DisplayAlerts = False
        ActiveWindow.SelectedSheets.Delete
        Application.DisplayAlerts = True
        
        Sheets(strMySheet).Select

        Exit Sub

    End If
    
'    'データがなかった場合 (フィールド名がない場合)
'    If lngLastRow = 1 And Cells(1).Value = Empty Then
'        MsgBox "該当データがありませんでした"
'
'        Worksheets(Worksheets.Count).Select
'
'        Application.DisplayAlerts = False
'        ActiveWindow.SelectedSheets.Delete
'        Application.DisplayAlerts = True
'
'        Sheets(strMySheet).Select
'
'        Exit Sub
'
'    End If
'-----------------------------------------------
    
    Application.DisplayAlerts = False

    'CSVファイルの作成
    ActiveSheet.Copy
    ActiveSheet.SaveAs Filename:=txtTMPNAME, FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close
    
    '追加したシートを削除
    Worksheets(Worksheets.Count).Select
    ActiveWindow.SelectedSheets.Delete
    
    Application.DisplayAlerts = True
    
    Sheets(strMySheet).Select
    MsgBox "作成完了しました", vbInformation

End Sub


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



Microsoft Office ブログランキングへ


 

Excel-VBA CSVファイルがエラーで開けない(SYLK ファイルであることを確認しましたが、読み込むことができません)

一行目の出だしが、『ID』で始まるCSVファイル、または、TXTファイルを Excelで開こうとすると、

28

↓ ↓ ↓ ↓ ↓ ↓

『 Excelは'ファイル名.txt'がSYLK ファイルであることを確認しましたが、読み込むことができません。ファイルにエラーが含まれるか、SYLK ファイル形式でない可能性があります。異なるファイル形式でそのファイルを開くには、[OK] をクリックしてください。 

というエラーが表示される。

これは、Excelが、CSV形式のCSVファイル、TXTファイルを、SYLKと認識してしまう為だ。
対応方法は、一行目の出だしが、IDでなければ良いだけだ。
「'ID」にしたり、「"ID"」にしたり、「商品ID」にしたり、一時的に変更すれば良い。

突然、CSVファイルがエラーで読めなくなり、困っていたら、こんな事が原因でした。


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



Microsoft Office ブログランキングへ



Excel-VBA CSVファイルを1行づつ読み込む Split関数 / Input / Line Input

小さいCSVファイルならば、高速に読み込むことを考えず、Textファイルに変換してから読み込まなくても良いだろう。

コードも短く、読みやすいのが利点。また、全てのデータを読み込まずに必要なデータを入手したら止めることもできるし、データを処理しながら読み込むこともできる。

まず、Line Input と、Split関数を用いた方法で、1行毎のデータを、カンマをもとにSpliet関数で配列に入れている。

Sub Sample()
    Dim text1 As String
    Dim myData1 As Variant
    Dim i As Long
    
    Open "C:\Users\HIDE\Desktop\新しいフォルダー\myBook1.csv" For Input As #1
    
    Cells.ClearContents
    Cells(1).Select
    
    Do Until EOF(1)
        Line Input #1, text1
    
        myData1 = Split(text1, ",")
    
        For i = 0 To 3
        
            Cells(ActiveCell.Row, i + 1).Value = myData1(i)
        
        Next i
        
        ActiveCell.Offset(1).Select
    
    Loop
    
    Close #1

End Sub


こちらは、Input で、1行毎にフィールドの要素を配列に入れていく方法

Sub Sample2()
    Dim text1 As String
    Dim myData(3) As Variant
    Dim i As Long
    
    Open "C:\Users\HIDE\Desktop\新しいフォルダー\myBook1.csv" For Input As #1
    
    Cells.ClearContents
    Cells(1).Select
    
    Do Until EOF(1)
        Input #1, myData(0), myData(1), myData(2), myData(3)
    
        For i = 0 To 3
        
            Cells(ActiveCell.Row, i + 1).Value = myData(i)
        
        Next i
        
        ActiveCell.Offset(1).Select
    
    Loop
    
    Close #1

End Sub

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



Microsoft Office ブログランキングへ



 


記事検索
Excel VBA ノートについて(注意事項)
このExcel VBA ノートは、Hide Tamura の個人的なVBAノートです。プログラムを再利用したり、コピペで入力の手間を省く為に作ったネット上のノートです。 その為、詳しい解説は書いておりません。エラー等のトラブルには責任は負いません。利用者の環境に合わせて書き換えてご利用ください。
ExcelVBA教室
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ノート
アクセスカウンター

    • ライブドアブログ