複数のフォルダをワンクリックで開くpythonをexe化してみました。

複数のフォルダやファイルをワンクリックで同時に起動してその際に右や左の画面に移動したりしていましたが、それすらも省略したいなーと思い、ちょっと調査。 bat、ps1、vbsでは挫折したので、pythonでコードを組んで、exe化しました。 だいぶ強引ですけどね。 pythonのexe化の方法は、「pyinstaller sample.py –onefile –noconsole」などで検索するといっぱい出てきますので割愛。

注意事項

Pythonの実行環境が無いと動きません。

メモ帳で下部のコードをコピーしたのち保存して、ファイル名を「sample」拡張子を「.py」にしてください。

以下コード

import pyautogui import subprocess def open_folder(path): subprocess.run('explorer {}'.format(path)) # フォルダのパスを設定 folder_path1 = r"C:\Users\●●●\OneDrive\●●１個目のウインドウのタイトル●●" folder_path2 = r"C:\Users\●●●\Documents\●●2個目のウインドウのタイトル●●" folder_path3 = r"C:\Users\●●●\OneDrive\Desktop\●●3個目のウインドウのタイトル●●" open_folder(folder_path1) open_folder(folder_path2) open_folder(folder_path3) import time print("処理を開始") time.sleep(4) import pygetwindow as gw print(gw.getAllTitles()) # ウィンドウを取得する。 my_window = gw.getWindowsWithTitle('●●1個目のウインドウのタイトル●●')[0] my_window.activate() # ウィンドウの位置とサイズを設定 left = 0 top = 0 width = pyautogui.size().width // 2 height = pyautogui.size().height my_window.resizeTo(width, height) # ウィンドウを指定の位置に移動 my_window.moveTo(left, top) # ウィンドウサイズを取得する print(my_window.size) print(my_window.topleft) print(my_window.bottomright) print("処理を開始2") time.sleep(1) my_window = gw.getWindowsWithTitle('●●2個目のウインドウのタイトル●●')[0] my_window.resizeTo(width, height) my_window.moveTo(width*2, top) print("処理を開始3") time.sleep(1) my_window = gw.getWindowsWithTitle('●●3個目のウインドウのタイトル●●')[0] my_window.resizeTo(width, height) my_window.moveTo(width, top)

近況について

あいかわらず元気にしています。

今のところ転勤等もなく、結構現場にも出てお手伝いをしています。今はメンバーにも恵まれており、さくさく吸収してくれるのがありがたい。

Pythonにて8桁の日付を頭に入れて複数のファイルをコピーするコード

Excelのマクロがセキュリティでかっちかちになっていますので、Pythonにて8桁の日付を頭に入れて複数のファイルをコピーするコードです。

注意事項

Pythonの実行環境が無いと動きません。

メモ帳で下部のコードをコピーしたのち保存して、拡張子を「.py」にしてください。

最後のコピーするファイルの設定の箇所を任意に調整し、コピーしたいファイルと同じフォルダで実行してください。

既にファイルがあるとエラーになります。

以下コード

import datetime import glob import shutil # ファイルの頭につけたいので # 今日の日付を8桁にして設定しています。 today8 = datetime.date.today().strftime('%Y%m%d') print(today8) # ファイルをコピーする関数を設定しています def myfunc(fname0, num): # ファイルを検索して、リストに入れています file1 = glob.glob('*' + fname0 ) # ファイルをコピーしています。 shutil.copyfile(file1[num],today8 + fname0) # コピーするファイルの設定をし、関数にて処理しています # リストを取得した際　最後のファイルの場合は-1です # リストを取得した際　最後から2つ目のファイルの場合は-2となります myfunc('一覧解析マクロ.xlsm',-1) myfunc('アウトルックメール解析マクロ.xlsm',-1) myfunc('分析マクロ.xlsm',-2)

近況について

お久しぶりです。なんやかんや元気です。

2023年度は　ぼちぼちと更新や編集するかもしれないです。

メール他でのファイル配布やリンク配布なども、何かとセキュリティリスクある昨今。

自分の知っている範囲の知人友人に伝えたりする際に、自分の場所があるのは都合良かったりします。

Power Automate Desktop 簡易起動スクリプト

Power Automate Desktopを簡易的に起動するスクリプトです。

特定のものを何度も起動する場合は、便利だと思います。

当方　Windows10 Home　32bitの環境です。　

メモ帳で下部のコードを保存して、拡張子を「.vbs」にすれば、たぶん動くはず。

注意事項

Power　Automate　Desktopは閉じた状態から始めています。

一番上に実行したいものが表示されるようにしています。

Power　Automate　Desktopは前の状態を保持しているので、

検索窓などでカーソルが残ったまま終了していると、

結果が変わってしまいます。

たいていは前回実行後の状態なので、 

いったん一覧の1つ目を強制的に実行しています。
もし数種類使い分けたい場合は、PGUPの後にDOWN

以下コード

Option Explicit Dim objWshShell 'シェルオブジェクトの作成 Set objWshShell = WScript.CreateObject("WScript.Shell") 'シェルの実行 objWshShell.Run """C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Power Automate Desktop\Power Automate Desktop.lnk""" 'パソコンのスペックにより時間が前後するので、起動待ちも含めて2回上下に移動させています。 WScript.Sleep(500) objWshShell.SendKeys("{PGDN}") WScript.Sleep(500) objWshShell.SendKeys("{PGUP}") WScript.Sleep(500) objWshShell.SendKeys("{PGDN}") WScript.Sleep(500) objWshShell.SendKeys("{PGUP}") WScript.Sleep(500) '最上部のものを実行しています objWshShell.SendKeys("{TAB}") WScript.Sleep(500) objWshShell.SendKeys("{ENTER}")

複数のExcelのファイルを一気に開くVBA

グループウェアが浸透すれば、脱Excelして、2度手間入力など劇的に減ります。

ただ、なかなかグループウェアを導入できない環境であると、

いくつもファイルを開いて作業をすることがあります。

Pythonも便利なんですが、環境を整えたりすることが大変なこともあるので、今回はＶＢＡだけでできるものです。

A1からA3セルにファイルパスを入力しておけば、VBAマクロで開けるようになっています。

今は、Excelのみで、WordやPDFなどには対応させていません。

ファイルがないときには最後にメッセージが出るようにしています。

以下コード

Option Explicit Sub FileOpen() Dim FPath As Variant 'ファイルパスの場所 FPath = Range("A1:A3") Dim NoFile As String Dim i As Integer For i = 1 To 3 'ファイルがないときの処理 If Dir(FPath(i, 1)) = "" Then NoFile = NoFile & "『" & FPath(i, 1) & "』のファイルが存在しませんでした" & Chr(13) Else 'ファイルがあるとき　開く Workbooks.Open FPath(i, 1) End If Next MsgBox "処理がおわりました。" & Chr(13) & NoFile End Sub

メール送信時気を付けている事

今回はメールの送信時の記事です。

電話がかかってくる頻度は少なくなったものの、できればチャットツールを使ってほしいのですが諸事情があり業務においてはメールが主流となっています。さて私見ではありますが、もらってうれしいメールをまとめます。

• 　内容が件名で分かる。件名で要約されている。
• 　後日検索もしやすい。
• 　スレッド表示で返信転送の件数が増えたわりに内容が短くわかりやすい。

こんなところでしょうか？逆にメールを送るときには下記のようにしています。

件名について

• 頭の2文字は内容によって統一しておく

　並び替えや振り分けに対応できるため

•  件名は前半で意味が読み取れるようにする

　件名の表示の文字切れせず理解できるようにしておくため

• 返信の際にむやみに件名を変更しない

　「スレッドとして表示」が崩れる原因となるため

　　

本文について

• 本文で事足りることを添付ファイルとしない

　メール検索で出てくるようにするため

 

著名について

• スクロールが少なくてすむように著名を短くしておく

　例＋＋＋＋＋＋区切り記号　

　会社名　所属

　役職　名前

　E-mail

　＋＋＋＋＋＋＋区切り記号

返信や転送の際について 　

• スクロールが少なくてすむようにスペースを省略する

　　返信が連続して続く際には　著名は省略する

• 返信や転送の際、不必要に本文に残ったcc情報などは削除する

　　転送の連続なのにずっとccが残ったままのメールはちょっと引きます。

Excelで一定のファイルを各フォルダへコピーするマクロ

経緯と概要

　ある業務のスタート時に、一定のファイルを各フォルダ毎に用意し、そのファイル名を変更するといった事があります。以前は、フォルダに先にファイルをコピーし、各フォルダにてファイル名を変更するといった事を行っており、大変手間がかかっていました。

　それから、一定のファイルを一括でファイル名の変更をしていましたが、それでも各フォルダにファイルをコピーする手間がありました。

　今回は、Excelにて、フォルダにある一定のファイルを各フォルダに振り分けてコピーするマクロです。これまでのようにフォルダを開いたり閉じたりすることや、フォルダ毎にファイルを選ぶ必要がなくなり、業務効率が向上しました。

マクロの設定の説明

Functionの関数の引数は3つ

1. フォルダの判定のキーワード（このマクロでは　コピー先に振り分けれるように　契約書用　申請用　図面用　と入力しています。判定はB列の4行目から行っています。）
2. 元のフォルダパスのセルのアドレスです。（このマクロでは　D1に元のファイルのアドレスをいれています。） 
3. コピー先のフォルダパスのセルのアドレスです。（このマクロでは　D3　J3　P3に各コピー先のアドレスを入力しています。）

マクロのデータについて

• A列4行目からB列27列目まで入っています。 
• A列はD1にあるフォルダパスのファイル名を入力しています。
• B列はフォルダの振り分け先判定用です。 
• 上書きの警告を表示するようにしていますが、「いいえ」を選択すると、それ以後の処理も止まります。

下記　画像のような状態にしています。

感想

今回のマクロもボタンで登録して行っているため、大変便利になりました。

（別のファイル名の一括変更のマクロと組み合わせているので、更に楽になっています）

コードも数行ですので、編集しやすいと思います。

以下コード

Function Fcopy(kyw As String, oldPathAdrs As String, newPathAdrs As String) As String For i = 4 To 27 oldPath = Range(oldPathAdrs).Value & "\" & Cells(i, 1).Value newPath = Range(newPathAdrs).Value & "\" & Cells(i, 1).Value If Cells(i, 2).Value = kyw Then If Dir(newPath) <> "" Then ret = MsgBox("同名のファイルが存在します。" & vbCrLf & _ newPath & vbCrLf & _ "上書きしますか？", vbYesNo) If ret = vbNo Then Exit For End If FileCopy oldPath, newPath End If Next MsgBox (kyw & "をコピーしました。") End Function Sub 契約書() Call Fcopy("契約書用", "D1", "D3") End Sub Sub 申請() Call Fcopy("申請用", "D1", "J3") End Sub Sub 図面() Call Fcopy("図面用", "D1", "P3") End Sub

Excelでシート名の変更とシートを追加するマクロ

概要

Excelのシートを、〇月〇日～〇日というシート名に変更するマクロです。  

1つ目のシートから最後のシートまで、F1の値をシート名にしています。

もし同じ名前のシートがある場合は処理しません。

前のシートのA4のセルが日付の基準のセルとしています。

F1のセルの数式 は

『=TEXT(A4,"m月d日～")&TEXT(A4+6,"d日")』

としてセルの表示形式を整えています。 

これでA4のセルの値を基準として　〇月〇日～〇日　となります。
（このF1のセルがシート名となります。）

シート名の変更のコード

Sub シート名の変更() 'エラーを無視 On Error Resume Next '1つ目のシートから最後のシートまで繰り返す For i = 1 To Sheets.Count 'シートの名前をF1の名前にする Sheets(i).Name = Sheets(i).Range("F1").Value 'もし選択しているシートが最後ではない場合、次のシートへ移動 If ActiveSheet.Name <> Sheets(Sheets.Count).Name Then ActiveSheet.Next.Activate End If Next End Sub  

シート追加のコード  

また、シートを追加するマクロも作っています。

前のシートのA4のセルが日付の基準のセルとしています。

F1の値をシート名に変更しています。

  Sub シート追加() 'エラーを無視 On Error Resume Next '最後のシートを、その次のシートとしてコピーする Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count) '最後のシートのA4を選択 Sheets(Sheets.Count).Range("A4").Select 'A4に最後から1枚前のシートに7を足した数式を入れる（1週間なので+7） Range("A4") = "='" & Sheets(Sheets.Count - 1).Name & "'!RC+7" 'シート名をF1の名前にする Sheets(Sheets.Count).Name = Sheets(Sheets.Count).Range("F1").Value End Sub

Excelにて重複したセルを削除するマクロ

Excelにて重複したセルを削除するマクロです。

クエリなどで他のデータを読み込んで、ピポットテーブルで内容をみていますが、

メールアドレスなど項目の重複を避けたい時がありました。

クエリやピポットテーブルやには既にフィルタが適用しているし、クエリやピポットの結果による重複を避けて調べたい。ただ、もう一つクエリやピポットを作るほどでもないので、ちょっとマクロにて処理してデータを取り出しています。

マクロの内容

「データ元ファイルパス」のシートのC行をクリア
「ピポット」のシートのＧ行をコピー

「データ元ファイルパス」のシートにて
C行に値で貼り付け
C行で重複した行を削除(1行だけですが）
処理したセルをコピー（次の操作につなげるため）
C3セルを選択して、上の方を表示（次の操作がしすいため）

以下コード

Sub 重複削除() Sheets("データ元ファイルパス").Select Columns("C:C").Select Selection.Clear Sheets("ピボット").Select Columns("G:G").Select Selection.Copy Sheets("データ元ファイルパス").Select Columns("C:C").Select '値で貼り付け Selection.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False 'C1からC200までで重複したセルを削除 ActiveSheet.Range("C1:C200").RemoveDuplicates Columns:=1, Header:=xlNo 'Columns範囲で指定した中で左から何列目か 'Header範囲内1行目をヘッダーとして扱うか（扱う場合はxlYes） Range("C3").Select '選択した位置から下に連続したセルまで選択 Range(Selection, Selection.End(xlDown)).Select '次の操作につなげるためコピー Selection.Copy '表示を上の方にするため選択 Range("C3").Select End Sub

pythonで強引にWEB入力する方法

WEBの入力フォームの後半が毎回一定の入力であるため、途中から自動操作で入力したい場合があります。


この自動操作をpythonにて実行するにあたり、最初のログイン状態からでは2段認証や条件の分岐が多すぎるため、5秒以内に定位置にマウスをもっていくことで、Webページの途中から強引に入力しています。


Excelにあるセルを読み込むことと、キーボード操作をTABやEnterなどを自動で押し、また、ちょっとした分岐も作成しています。
マウス座標での操作は画面の解像度によって左右されるため、カーソルの移動はTABとShift＋TABなどをメインにしています。

以下pythonのコード 

#ワークシートの読み込み from openpyxl import load_workbook #読み込み先ファイル　同じフォルダにいれておく filename = '●●●●.xlsm' wb = load_workbook(filename, read_only=True) print(f'{filename}のワークシート情報を読み込みます') sheet = wb['sample'] #日付の書式の確認　Webフォームで入力する際　型が違うとエラーになったため import datetime dd = sheet.cell(row = 26 ,column = 2 ).value #26行目の値 日付' print(dd) print(str(dd.year)+'/'+str(dd.month)+'/'+str(dd.day)) dd2 = str(dd.year)+'/'+str(dd.month)+'/'+str(dd.day) import pyautogui import pyperclip import time #5秒以内に定位置にマウスをもってくる time.sleep(5) pyautogui.press('tab') #提出先監督部 for i in range(1): pyautogui.press('tab') pyautogui.press('home') for i in range(6): pyautogui.press('down') for i in range(2): pyautogui.press('tab') time.sleep(0.1) pyperclip.copy('代表取締役') pyautogui.hotkey('ctrl', 'v') #詳細情報のタブへ移動 for i in range(6): pyautogui.hotkey('shift', 'tab') time.sleep(0.1) pyautogui.press('right') #需要設備をチェック　Webフォームの枠が増えるため for i in range(15): pyautogui.press('tab') pyautogui.press('space') for i in range(7): pyautogui.press('tab') #附属情報　変更年月日 pyperclip.copy(dd2)#26行目の値　日付書式注意 pyautogui.hotkey('ctrl', 'v') pyautogui.press('tab') #pyperclip.copy('代表取締役') text = sheet.cell(row = 28 ,column = 2 ).value #28行目の値' pyperclip.copy(text) pyautogui.hotkey('ctrl', 'v') bunki = sheet.cell(row = 15 ,column = 2 ).value #15行目の値' if bunki == 1: #新規0　変更1 #新規の場合　以下をコメント化 #保安規程変更理由 for i in range(2): pyautogui.press('tab') for i in range(7): pyautogui.press('down') time.sleep(0.1) pyautogui.press('up') #内容詳細 for i in range(1): pyautogui.press('tab') time.sleep(0.1) text = sheet.cell(row = 33 ,column = 2 ).value #33行目の値' pyperclip.copy(text) pyautogui.hotkey('ctrl', 'v') time.sleep(0.1) for i in range(2): pyautogui.press('tab') time.sleep(0.1) pyautogui.press('tab')#----新規の場合1回だけ pyautogui.press('space') pyautogui.press('tab') pyautogui.press('space') #主任技術者の選任形態 pyautogui.press('tab') pyautogui.press('end') pyautogui.press('up') #添付書類へ移動 for i in range(1): pyautogui.press('tab') for i in range(3): pyautogui.press('right') #保安規程 for i in range(2): pyautogui.press('tab') time.sleep(0.2) pyautogui.press('space') #一時保存 for i in range(8): pyautogui.press('tab')

メール本文をExcelで自動化

Outlookの特定のメールフォルダを分析するExcelマクロ

毎日定型文にて定時メールが届き、毎日入力しなければならない場合、マクロボタン１つで入力から分析までできるようにしました。

内容をお見せすることができないのが申し訳ないです。

そのうちに黒塗りしてお見せします。

ーーーーーー

Excelの「開発」「Visual Basic」「ツール」「参照設定」にて

　Microsoft　Office　？　Object Library　をチェック

Excelで今回の記事に関係するシートは３つ【メールデータ】【分析結果】【ピボット】

【メールデータ】のシートはOutlookから「受信日時」「件名」「送信者」「送信元メールアドレス」「本文」を取得しており、「定期メールデータ」というテーブルを設定

【分析結果】のシートは【メールデータ】のシートの「定期メールデータ」というテーブルからパワークエリにて行列の整理

【ピボット】のシートは【分析結果】のシートをピボットテーブルにて「受信日」と「件名」と各値を表示されるように調整

Excelにマクロをボタン登録しておく

Outlookの対象フォルダは「●●●●」に目的のメールを仕分けのルールで振り分けておく

ーーーーー

以下コード Set myNamespace = outlookObj.GetNamespace("MAPI") Set InboxFolder = myNamespace.GetDefaultFolder(6).Folders("●●●●") n = 2 For i = 1 To InboxFolder.Items.Count Set objmailItem = InboxFolder.Items(i) Range("A" & n).Value = i Range("B" & n).Value = objmailItem.ReceivedTime Range("C" & n).Value = objmailItem.subject Range("D" & n).Value = objmailItem.SenderName Range("E" & n).Value = objmailItem.SenderEmailAddress Range("F" & n).Value = Trim(objmailItem.Body) n = n + 1 Next Call クエリピボット更新 Application.ScreenUpdating = True End Sub Sub クエリピボット更新() Sheets("分析結果").Select Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False Sheets("ピボット").Select ActiveSheet.PivotTables("ピボットテーブル1").PivotCache.Refresh End Sub Sub クリア() Sheets("メールデータ").Range("A1").Select Range("A3:F" & Range("A1").End(xlDown).Row).Select Selection.Delete Shift:=xlUp Range("A2").Select End Sub

ワンタイムパスワード入力中は一時停止して自動化

　Webブラウザーの入力フォームを何度も行うことがあります。csvなどにてデータの流し込みができないサイトであった場合は、手入力を何度もしなければならず、せっかくの手元にあるデータを生かすことができませんでした。

　Webブラウザーの自動操作のためにseleniumを使ってはいましたが、selenium実行後にはブラウザーが閉じてしまう事と、ワンタイムパスワードや2段認証などセキュリティの高いサイトには対応しにくいのが難点でした。

　ログイン後の操作にも必要性が生じてきたので、いったん処理の途中でメモ帳を開いて一時停止中に入力することで自動化を進める事にしました。

以下Pythonのコード

import os from selenium import webdriver print ("●●●\nにログイン\nします") URL= 'https://www.●●●' driver = webdriver.Chrome("C:/chromedriver_win32/chromedriver.exe") driver.get(URL) #ボタンをクリック login_btn = driver.find_element_by_xpath("○○○") login_btn.click() #ログインID login_id = driver.find_element_by_id("username") login_id.send_keys("△△△") #ログインパスワード login_pass = driver.find_element_by_name("password") login_pass.send_keys("□□□") #ボタンをクリック login_btn = driver.find_element_by_class_name("submit_btn") login_btn.click() #メモ帳起動で一時停止するため print ("メモ帳を起動している間に\nワンタイムパスワードを\n入力し、入力し終わったらメモ帳を閉じてください") os.system("notepad.exe") login_btn = driver.find_element_by_class_name("submit_btn") login_btn.click() #ブラウザが閉じるため再度一旦停止しています。これからブラウザでの処理を実施 os.system("notepad.exe")

キーボードで一度に複数のファイルを開く方法

　今回はキーボードで一度に複数のファイルを開き、作業環境を整える方法についての記事です。

　作業環境を整える際に複数のフォルダやファイルを開いく必要があると思いますが、以前の記事で紹介したマウスのカーソルを動かすより、キーボードをつかって実行すると素早くできます。

　過去の記事は、「ワンクリックで複数のフォルダやファイルを開く方法」をクリック

　また、コルタナも使って行えないかやってみましたが、失敗することや、話せない環境であったり、時間がかかることから、まったく使わなくなりました。コルタナについては、他の作業においても音声入力の割合が増えてくるなら、状況は変わってくると思います。

　過去の記事は、「コルタナを使って複数のフォルダやファイルを開く方法」をクリック

実際の手順

「複数のフォルダやファイルを開くショートカット」を作成する

　作り方は過去の記事を参照願います。「ワンクリックで複数のフォルダやファイルを開く方法」をクリック

先ほどのショートカットをWindowsのスタートメニューに登録する

　場所は環境によって若干変わるかもしれませんが、「C:\ProgramData\Microsoft\Windows\Start Menu\Programs」と思います。

このフォルダの中に先ほどのショートカットを置いてください。

　ショートカットキーを設定する

　ショートカットを右クリックしてプロパティの画面から、ショートカットキーを設定してください。今回作るショートカットが「初期設定」という名前なので、、ここでは「s」にしています。「s」とキーボードを入力すると、「Ctrl＋Alt＋s」の3つキーを同時に押すことで動くようになります。

順番にキーを押して操作できるようにショートカット名を変更しておく

3つボタンを押す以外に、ショートカットの名前の頭に「sss」のような半角英字を入れておくと便利です。キーボードを「Windowボタン」「s」を3回順番におすと、最も一致する検索結果に出てくるはずなので、「Enter」に押すことで動くようにもできます。

最後に

いかがでしたでしょうか？まだ、だいぶ省略していますので、ちょこちょこと詳しくして更新していきます。過去の記事もちょっとずつ、こちらに引っ越ししてきます。

Excelでファイルをコピーし、名前を付けて保存してからマクロ実行をワンクリックで実行

　他の人とファイルを共有していると、元のファイルに手を加えることができないことがあると思います。　しかし、いつも決まりきったデータを編集しなければならないことがあると思います。

そんな時は、みなさんどうしていますか？

元のファイルのフォルダを開いて、元のデータファイルを選んで、ファイルをコピーして、別の場所を選んで、貼り付けて、ファイルの名前を変えてから編集していますか？

　もしくは、

元のフォルダを開いて、元のデータファイルを選んで、開いて、別の名前で保存して、編集していますか？

普通にすると何手順も必要でしたが、「ファイルを開くところから、編集する」ところまでを、下記のコードのようにして、自動化しています。

Excelには、「マクロ用」というシートと、

A1のセルにはデータ元のファイルのファイルパス

例　C:\Users\●●●●\OneDrive\●●●●\●●●●.xlsx

A2のセルにはコピー先のファイルのファイルパス

例　C:\Users\●●●●\OneDrive\Desktop\□□□□.xlsx

「色付け」というマクロ

を設定しています。

　月初に1回だとしても年12回だけですが、決まりきったルーティンワークはできるだけ自動化していってます。一つ一つのコードで短縮できる時間はわずかではありますが、ちょっとずつ重ねると本当に楽になります。

　できればマクロ実行自体を自動化したい、そもそもマクロなどを実行しなくていい環境にしたいところではありますが・・・

　マクロをボタンに登録してワンクリックにて実行し、その間にトイレに行ったり、お茶したりして、次の構想を練っています。

以下コード

Option Explicit Sub A1をA2の名前でコピー() Dim ret As Long Dim FnDatamoto As String Dim FnCopysaki As String FnDatamoto = Sheets("マクロ用").Range("A1").Value FnCopysaki = Sheets("マクロ用").Range("A2").Value '同名ファイルの上書き確認 If Dir(FnCopysaki) <> "" Then ret = MsgBox("同名のファイルが存在します。" & vbCrLf & _ "上書きしますか？", vbYesNo) If ret = vbNo Then Exit Sub End If 'ファイルをデータ元からコピー先へコピーする FileCopy FnDatamoto, FnCopysaki 'コピー先のファイルを開く Workbooks.Open FnCopysaki 'ファイルを開いた先で　別のマクロを実行する　ここでは「色付け」 Call 色付け　 End Sub

Word VBAマクロ事例 次のファイルを保存してPDF出力

　Wordの差し込み文章で用意されたものを、PDF化する際に、Wordのマクロにてパパっと自動化できるようになりました。

　今までは、差し込み文章の個別編集、ファイル名変更、印刷ボタンを押し、出力先をPDFに選択して、コメントを消して、保存して、ファイル名を変更してといったことをやっていました。

　下記をWordマクロを、クイックツールバーに登録するとワンクリックでできるようになりました。 

以下コード

Sub 次ファイルを保存PDF出力() Dim fn1 As String With ActiveDocument.MailMerge .DataSource.ActiveRecord = wdNextRecord '次のレコード .Destination = wdSendToNewDocument '差し込み文章を新しくつくる .SuppressBlankLines = True '空白のデータは無視 With .DataSource fn1 = .DataFields("○○○○").Value 'ファイル名用　○○は差し込み文章のフィールドの項目 .FirstRecord = .ActiveRecord '最初のレコードはアクティブドキュメントのもの .LastRecord = .ActiveRecord '最後のレコードはアクティブドキュメントのもの End With .Execute Pause:=False '印刷エラーの時　Trueだと一時停止 End With ActiveDocument.SaveAs2 FileName:="C:\△△\□□\" & Format(Now, "yyyyMMddHHmmss") & fn1 & ".docx" ActiveDocument.SaveAs2 FileName:="●●●書（" & fn1 & "）.docx" 'ファイル名 'コメントは印刷しない ActivePrinter = "Adobe PDF" Application.PrintOut FileName:="", _ Range:=wdPrintAllDocument, _ Item:=wdPrintDocumentContent, _ PageType:=wdPrintAllPages, _ Collate:=True, Background:=True Documents("●●●書（" & fn1 & "）.docx").Close End Sub

テスト投稿です。

 こっちで投稿してみた。