忍者ブログ
  • 2025.05《
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 》 2025.07
[PR]
×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

2025/06/19 23:14 |
OtherApp
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
2015/04/14 21:42 | Excelマクロ(VBA) | コメント(0)
<<Other | ホーム | Shapes>>
コメント
コメントの投稿















前ページ | ホーム | 次ページ