× [PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。 |
![]() |
Excelマクロのモジュールをそのまま貼り付け。
(会社とか家とか出先とかで見るため) 「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に! 貼り付け後、「■Sub 」を「Sub 」に置き換えよう! ※公開している以上、利用は自由ですが、自己責任で。 Option Compare Binary Option Explicit 'VBAで他のアプリケーションを制御 ■Sub 他のアプリケーションを開く() 'メモ帳 Dim NP As Double '倍精度浮動小数点数型 NP = Shell("Notepad.exe", vbNormalFocus) 'メモ帳を開く End Sub ■Sub 他のアプリケーションでいろいろなファイルを開く() 'Shellで直接指定するのは、EXE形式のアプリケーション '構文は:Shell アプリケーションへのフルパス+名前 開きたいファイルのフルパス+名前, ウィンドウ状態※, 待機有無※ 'Shell関数で半角スペースを含むファイルを開く場合は、 ' ファイル名をひとつの連続した文字列として認識させるために二重引用符 (") で括る '【参考】http://officetanaka.net/excel/vba/tips/tips90.htm Shell "C:\WINDOWS\system32\mspaint.exe ""C:\Documents and Settings\a05076\My Documents\J1000739.JPG""", vbNormalFocus ' ↑ ↑ ↑ ' 関数を囲む(") スペースを含むパスを囲む("") スペースを含むパスを閉じる("")と関数を閉じる(") '↑"が1個足りない気が‥いいのか? '変数を利用する(パスにスペース有り) Dim P As String P = """C:\Documents and Settings\a05076\My Documents\J1000864.JPG""" Shell "C:\WINDOWS\system32\mspaint.exe " & P, vbNormalFocus '※ウィンドウ状態 '値 意味 定数作成例 '0 ウィンドウを非表示 vbHide '1 通常のウィンドウ、かつ最前面 vbNormalFocus '2 最小化、かつ最前面 vbMinimizedFocus '3 最大化、かつ最前面 vbMaximizedFocus '4 通常のウィンドウ、not最前面 vbNormalNoFocus '6 最小化、not最前面 vbMinimizedNoFocus '※待機有無 'True 実行したプログラムが終了するまで、スクリプトの処理を待機 ' ※実行したプログラムの終了コードを参照するときは、こちらを指定してください。 'False スクリプトの処理を続行 End Sub ■Sub 他のアプリケーションでいろいろなファイルを開くその2() a& = Shell("c:\MSOffice\WinWord\winword.exe", 1) 'Shell関数でWordを起動しておく Dim wobj As Object 'wobj をオブジェクト変数として宣言 Set wobj = GetObject("", "Word.Basic") 'wobjを Word.Basic のオブジェクトとして作成 wobj.fileopen ActiveCell.Value 'Word.Basic のFileopenメソッドで ActiveCell のファイルをWordで開く Set wobj = Nothing 'オブジェクトの開放。 End Sub ■Sub メモ帳で文字コード変換して保存() 'ファイルをメモ帳で開いて、文字コードを「ANSI」(Shift-JIS)に変更して別名保存する。 '★メモ帳で保存するファイル名が既にあると途中で止まるので注意(確認記述あり)★ Dim Path As String '元ファイルパス Dim nFile As String 'メモ帳で開く別名保存するファイルパス Dim eFile As String 'Excelで開くファイルパス Dim macroF As String 'マクロブック名 On Error GoTo エラー処理 'マクロブック名を取得 macroF = ThisWorkbook.Name 'ファイルを特定 Path = Application.GetOpenFilename("すべてのファイル,*.*", Title:="ファイルを選択してください。") If Path = "False" Then MsgBox "キャンセルされました。 ", vbOKOnly + vbExclamation Application.Quit 'Excel終了(マクロが終了するまでWeitされる) 'Workbooks(macroF).Close 'マクロファイルを閉じる 'End 'マクロ終了 End If 'メモ帳で別名保存するファイルパスを取得 eFile = Left(Path, Len(Path) - 4) & "1" & Right(Path, 4) If Dir(eFile) <> "" Then '同じファイル名がある場合は終了★ MsgBox "別名保存するファイル名(パス)が存在します。 " & vbNewLine & _ "下記のファイル名を変更するか、削除してください。 " & vbNewLine & vbNewLine & _ eFile & " ", vbOKOnly + vbExclamation, "ファイルの重複" Application.Quit 'Excel終了(マクロが終了するまでWeitされる) Workbooks(macroF).Close 'マクロファイルを閉じる End 'マクロ終了 End If 'メモ帳で使えるようにファイル名を加工 Path = """" & Path & """" '結果:"D:\My Documents\xxx.xxx"(スペースのあるパスを有効にする) nFile = """" & eFile & """" Debug.Print Path Debug.Print eFile Debug.Print nFile 'メモ帳で元ファイルを開く Shell "C:\WINDOWS\system32\notepad.exe " & Path, vbNormalFocus '文字コードを変更してファイルを保存 SendKeys "%fa", True '[ファイル]-[名前をつけて保存] SendKeys nFile, True ' ファイル名を入力 SendKeys "%e", True '[文字コード]を選択 ' myTime = Now + TimeSerial(0, 0, 1) SendKeys "ANSI", True '「ANSI」を入力(Shift-JIS) SendKeys "%s", True '[保存] ' SendKeys "%y", True SendKeys "%fx", True '[ファイル]-[メモ帳の終了] 'SendKeys解説 'キー コード 'SHIFT + 'CTRL ^ 'ALT % MsgBox "完了しました。 " Exit Sub エラー処理: MsgBox "エラーが発生しました。" & vbNewLine & _ "もう一度やり直してください。 ", vbCritical, "エラー発生" 'End Application.DisplayAlerts = False '確認メッセージを出さない Application.Quit 'Excel終了 '※親プロシージャがある場合は、親は終了しないので、「End」を置くこと。 End Sub ■Sub テキストファイルを作成して保存() 'InputBoxでファイル名を指定 Dim intFileNum As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) intFileNum = FreeFile strFileName = InputBox("ファイル名を指定してください") If strFileName <> "" Then strFileName = strFileName & ".txt" Open strFileName For Output As intFileNum Close #intFileNum End If End Sub ■Sub テキストファイルを作成して書き出し1() 'コードでファイル名を指定 '書き出す範囲をコードで指定 Dim intFileNum As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) Dim strREC As String ' 書き出すレコード内容 intFileNum = FreeFile strFileName = "てすと.html" Open strFileName For Output As intFileNum strREC = Cells(1, 1).Value Print #intFileNum, strREC ' 書き出し Close #intFileNum End Sub ■Sub テキストファイルを作成して書き出し2() '書き出す範囲を取得して書き出し Const cnsFILENAME = "\SAMPLE.txt" Dim intFF As Integer ' FreeFile値 Dim strREC As String ' 書き出すレコード内容 Dim GYO As Long ' 収容するセルの行 Dim GYOMAX As Long ' データが収容された最終行 ' 最終行の取得 GYOMAX = Range("A65536").End(xlUp).Row ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(出力モード) Open ThisWorkbook.Path & cnsFILENAME For Output As #intFF ' 2行目から開始 GYO = 2 ' 最終行まで繰り返す Do Until GYO > GYOMAX ' A列内容をレコードにセット(先頭は2行目) strREC = Cells(GYO, 1).Value ' レコードを出力 Print #intFF, strREC ' 行を加算 GYO = GYO + 1 Loop ' 指定ファイルをCLOSE Close #intFF End Sub PR |
![]() |
![]() |
|
![]() |