ここから本文です

下記マクロが動作終了後、メモ帳を起動してその内容をコピペして、今起動中のBook(...

vfi********さん

2017/8/218:17:55

下記マクロが動作終了後、メモ帳を起動してその内容をコピペして、今起動中のBook(作業用)を閉じるところまで実行したいです。

Sub Macro1()
Dim lr As Long
Dim xKey As Variant, i As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
xKey = Split("(*,(*, ", ",")
For i = 0 To UBound(xKey)
Range("A1:A" & lr).Replace _
What:=xKey(i), _
Replacement:="", _
MatchCase:=False
Next i
Application.DisplayAlerts = True
Range("B:C").Insert Shift:=xlToRight
Range("B2").Formula = "=LEN(A2)>1"
Range("A1:A" & lr).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B2"), _
CopyToRange:=Range("C1"), _
Unique:=False
Range("C1").Delete Shift:=xlUp
Columns("A:B").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

新規メモ帳を起動する。

上のマクロで完成したデータをメモ帳にコピペする。

開いていたBook(作業用)を保存しないでそのまま閉じる。

起動しているメモ帳はそのままにしておく。
ここまでを一連の動作を作業用Bookのマクロで実行したいのです。

そのあとは手動で別のBookを開いてから起動中のメモ帳の内容をコピペします。

補足rc = Shell("notepad.exe", vbNormalFocus)
Columns("A:A").Select
Selection.Copy

すいません。
メモ帳にコピーされなくてブックも閉じることが出来ませんでした

閲覧数:
80
回答数:
2
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

sk_********さん

2017/8/723:05:36

あくまで一例ですが、
マクロの実行で、Sampleを実行させてください。
Sampleを実行すると、
最初に、Macro1が実行される(この部分に関しては手をいれていません)
次に、A列をコピーし、
メモ帳を起ち上げ(2秒待機し)
メモ帳に貼り付け(1秒待機し)
メモ帳ウィンドウの最小化・・・フォーカスをExcelに戻すため
ファイルを保存せずにExcelを閉じる。

Sub Sample()
Call Macro1
Columns("A:A").Copy
Shell "Notepad.exe", 1
Application.Wait Now + TimeSerial(0, 0, 2)
AppActivate ("無題 - メモ帳")
SendKeys "^v"
Application.Wait Now + TimeSerial(0, 0, 1)
SendKeys "(% )n"
ThisWorkbook.Saved = True
Application.DisplayAlerts = False
Application.Quit
End Sub

Private Sub Macro1()
Dim lr As Long
Dim xKey As Variant, i As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
xKey = Split("(*,(*, ", ",")
For i = 0 To UBound(xKey)
Range("A1:A" & lr).Replace _
What:=xKey(i), _
Replacement:="", _
MatchCase:=False
Next i
Application.DisplayAlerts = True
Range("B:C").Insert Shift:=xlToRight
Range("B2").Formula = "=LEN(A2)>1"
Range("A1:A" & lr).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B2"), _
CopyToRange:=Range("C1"), _
Unique:=False
Range("C1").Delete Shift:=xlUp
Columns("A:B").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

  • 質問者

    vfi********さん

    2017/8/806:29:37

    どうもありがとうございます
    5日経過しまして質問を見つけていただいて感謝です
    まったくこの通りで動作OKです

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2017/8/8 06:30:09

この度のご回答誠にありがとうございました。

ベストアンサー以外の回答

1〜1件/1件中

hdu********さん

2017/8/310:52:08

そのままのサンプル有りましたよ。

https://www.moug.net/tech/exvba/0150106.html

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる