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

マクロの設定の説明

Functionの関数の引数は3つ

フォルダの判定のキーワード（このマクロでは　コピー先に振り分けれるように　契約書用　申請用　図面用　と入力しています。判定はB列の4行目から行っています。）
元のフォルダパスのセルのアドレスです。（このマクロでは　D1に元のファイルのアドレスをいれています。）
コピー先のフォルダパスのセルのアドレスです。（このマクロでは　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のシートを、〇月〇日～〇日というシート名に変更するマクロです。

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にて重複したセルを削除するマクロです。

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

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

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

マクロの内容

「データ元ファイルパス」のシートの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

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

登録: 投稿 (Atom)

E事例

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

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

件名について

本文について

著名について

返信や転送の際について

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

経緯と概要

マクロの設定の説明

感想

以下コード

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

概要

シート名の変更のコード

シート追加のコード