↓google drive
マクロ - Google ドライブ
drive.google.com
↓勤怠打刻マクロ
Sub 出勤打刻_リアルタイム()
Dim refPath As String '文字列型の変数(＝share勤務表が格納されているフォルダパス)を宣言
Dim refWb As Workbook 'ワークブック型のオブジェクト(＝share勤務表のファイルオブジェクト)を宣言
Dim sht As Worksheet 'ワークシート型のオブジェクト(＝現在の月)を宣言
Dim currentMonth As Long '整数型の変数(＝現在の月)を宣言
Dim currentDay As Long '整数型の変数(＝現在の日)を宣言
Dim currentHour As Long '整数型の変数(＝現在の時)を宣言
Dim currentMinute As Long '整数型の変数(＝現在の分)を宣言
Dim nRow As Long '整数型の変数(＝月初から月末までの入力行のカウンター)を宣言
currentMonth = Month(Now())
currentDay = Day(Now())
currentHour = Hour(Now())
currentMinute = Minute(Now())
refPath = "C:\Users\mtkbirdman\Desktop\ひつじマクロ" 'share勤務表が格納されているフォルダパス★
Set refWb = Workbooks.Open(Filename:=refPath & "\改_勤務表_名前.xlsx", Password:="0908") 'refWbに関数の戻り値(share勤務表のファイルオブジェクト)を格納する、開いてもいる★
With refWb '省略用
Set sht = .Worksheets(currentMonth & "月") 'shtに関数の戻り値(○月)を格納
For nRow = 4 To 34 '月初から月末までの入力行のループを開始
If sht.Cells(nRow, 1) = currentDay Then 'もしもA3～A34セルの値が現在の日と一致しているなら★
sht.Cells(nRow, 3) = currentHour '出勤時刻(時)を入力
sht.Cells(nRow, 5) = currentMinute '出勤時刻(分)を入力
End If
Next nRow
.Save 'share勤務表のファイルオブジェクトを保存
.Close 'share勤務表のファイルオブジェクトを閉じる
End With '省略適用ここまで
'メッセージボックスに出勤時刻と励ましを表示
MsgBox currentMonth & "/" & currentDay & Format(currentDay, "(aaa)") & " " & currentHour & ":" & currentMinute & _
vbCrLf & "おはよ～！"
End Sub
Sub 退勤打刻_リアルタイム()
Dim refPath As String '文字列型の変数(＝share勤務表が格納されているフォルダパス)を宣言
Dim refWb As Workbook 'ワークブック型のオブジェクト(＝share勤務表のファイルオブジェクト)を宣言
Dim sht As Worksheet 'ワークシート型のオブジェクト(＝現在の月)を宣言
Dim currentMonth As Long '整数型の変数(＝現在の月)を宣言
Dim currentDay As Long '整数型の変数(＝現在の日)を宣言
Dim currentHour As Long '整数型の変数(＝現在の時)を宣言
Dim currentMinute As Long '整数型の変数(＝現在の分)を宣言
Dim nRow As Long '整数型の変数(＝月初から月末までの入力行のカウンター)を宣言
currentMonth = Month(Now())
currentDay = Day(Now())
currentHour = Hour(Now())
currentMinute = Minute(Now())
refPath = "C:\Users\mtkbirdman\Desktop\ひつじマクロ" 'share勤務表が格納されているフォルダパス★
Set refWb = Workbooks.Open(Filename:=refPath & "\改_勤務表_名前.xlsx", Password:="0908") 'refWbに関数の戻り値(share勤務表のファイルオブジェクト)を格納する、開いてもいる★
With refWb '省略用
Set sht = .Worksheets(currentMonth & "月") 'shtに関数の戻り値(○月)を格納
For nRow = 4 To 34 '月初から月末までの入力行のループを開始
If sht.Cells(nRow, 1) = currentDay Then 'もしもA3～A34セルの値が現在の日と一致しているなら★
sht.Cells(nRow, 7) = currentHour '出勤時刻(時)を入力
sht.Cells(nRow, 9) = currentMinute '出勤時刻(分)を入力
End If
Next nRow
.Save 'share勤務表のファイルオブジェクトを保存
.Close 'share勤務表のファイルオブジェクトを閉じる
End With '省略適用ここまで
'メッセージボックスに出勤時刻と励ましを表示
MsgBox currentMonth & "/" & currentDay & Format(currentDay, "(aaa)") & " " & currentHour & ":" & currentMinute & _
vbCrLf & "おつかれ～～～～！！！！"
End Sub
Sub 出勤打刻_指定()
Dim refPath As String '文字列型の変数(＝share勤務表が格納されているフォルダパス)を宣言
Dim refWb As Workbook 'ワークブック型のオブジェクト(＝share勤務表のファイルオブジェクト)を宣言
Dim refSht As Worksheet 'ワークシート型のオブジェクト(＝指定の月)を宣言
Dim thisSht As Worksheet
Dim idxDate As Long '指定の日付を宣言★
Dim idxMonth As Long '整数型の変数(＝指定の月)を宣言
Dim idxDay As Long '整数型の変数(＝指定の日)を宣言
Dim idxTime As Single '指定の開始時間を宣言★
Dim idxHour As Long '整数型の変数(＝指定の時)を宣言
Dim idxMinute As Long '文字列型の変数(＝指定の分)を宣言
Dim nRow As Long '整数型の変数(＝月初から月末までの入力行のカウンター)を宣言
Set thisSht = ThisWorkbook.Sheets(1)
idxDate = thisSht.Cells(2, 1)
idxMonth = Month(idxDate)
idxDay = Day(idxDate)
idxTime = thisSht.Cells(3, 1)
idxHour = Hour(idxTime)
idxMinute = Minute(idxTime)
refPath = "C:\Users\mtkbirdman\Desktop\ひつじマクロ" 'share勤務表が格納されているフォルダパス★
Set refWb = Workbooks.Open(Filename:=refPath & "\改_勤務表_名前.xlsx", Password:="0908") 'refWbに関数の戻り値(share勤務表のファイルオブジェクト)を格納する、開いてもいる★
With refWb '省略用
Set refSht = .Worksheets(idxMonth & "月") 'shtに関数の戻り値(指定の月)を格納
For nRow = 4 To 34 '月初から月末までの入力行のループを開始
If refSht.Cells(nRow, 1) = idxDay Then 'もしもA3～A34セルの値が指定の日と一致しているなら★
refSht.Cells(nRow, 3) = idxHour '出勤時刻(時)を入力
refSht.Cells(nRow, 5) = idxMinute '出勤時刻(分)を入力
End If
Next nRow
.Save 'share勤務表のファイルオブジェクトを保存
.Close 'share勤務表のファイルオブジェクトを閉じる
End With '省略適用ここまで
'メッセージボックスに出勤時刻と励ましを表示
MsgBox Format(idxDate, "m/d(aaa)") & " " & Format(idxTime, "h:mm") & _
vbCrLf & "おはよ～！"
End Sub
Sub 退勤打刻_指定()
Dim refPath As String '文字列型の変数(＝share勤務表が格納されているフォルダパス)を宣言
Dim refWb As Workbook 'ワークブック型のオブジェクト(＝share勤務表のファイルオブジェクト)を宣言
Dim refSht As Worksheet 'ワークシート型のオブジェクト(＝指定の月)を宣言
Dim thisSht As Worksheet
Dim idxDate As Long '指定の日付を宣言★
Dim idxMonth As Long '整数型の変数(＝指定の月)を宣言
Dim idxDay As Long '整数型の変数(＝指定の日)を宣言
Dim idxTime As Single '指定の開始時間を宣言★
Dim idxHour As Long '整数型の変数(＝指定の時)を宣言
Dim idxMinute As Long '文字列型の変数(＝指定の分)を宣言
Dim nRow As Long '整数型の変数(＝月初から月末までの入力行のカウンター)を宣言
Set thisSht = ThisWorkbook.Sheets(1)
idxDate = thisSht.Cells(2, 1)
idxMonth = Month(idxDate)
idxDay = Day(idxDate)
idxTime = thisSht.Cells(4, 1)
idxHour = Hour(idxTime)
idxMinute = Minute(idxTime)
refPath = "C:\Users\mtkbirdman\Desktop\ひつじマクロ" 'share勤務表が格納されているフォルダパス★
Set refWb = Workbooks.Open(Filename:=refPath & "\改_勤務表_名前.xlsx", Password:="0908") 'refWbに関数の戻り値(share勤務表のファイルオブジェクト)を格納する、開いてもいる★
With refWb '省略用
Set refSht = .Worksheets(idxMonth & "月") 'shtに関数の戻り値(指定の月)を格納
For nRow = 4 To 34 '月初から月末までの入力行のループを開始
If refSht.Cells(nRow, 1) = idxDay Then 'もしもA3～A34セルの値が指定の日と一致しているなら★
refSht.Cells(nRow, 7) = idxHour '出勤時刻(時)を入力
refSht.Cells(nRow, 9) = idxMinute '出勤時刻(分)を入力
End If
Next nRow
.Save 'share勤務表のファイルオブジェクトを保存
.Close 'share勤務表のファイルオブジェクトを閉じる
End With '省略適用ここまで
'メッセージボックスに出勤時刻と励ましを表示
MsgBox Format(idxDate, "m/d(aaa)") & " " & Format(idxTime, "h:mm") & _
vbCrLf & "おつかれ～～～～！！！！"
End Sub
給与計算マクロ↓
Sub main()
'交通費含む給与が扶養内に収まるように計算するマクロ
'勤務表の指定月のシートから入力済みの出退勤時間を取得し、扶養上限までの残額を計算する
Application.DisplayAlerts = False
Dim refPath As String '文字列型の変数(＝share勤務表が格納されているフォルダパス)を宣言
Dim RefWb As Workbook 'ワークブック型のオブジェクト(＝share勤務表のファイルオブジェクト)を宣言
Dim sht0 As Worksheet 'ワークシート型のオブジェクト（＝share勤務表の指定月）を宣言
Dim sht1 As Worksheet 'ワークシート型のオブジェクト（＝給与計算シート）を宣言
Dim tgtMonth As String '文字列型の変数(＝指定月)を宣言
Dim existFlag As Boolean '指定月のシートが既に存在しているかどうかのフラグ TRUE:存在している、FALSE：存在していない
tgtMonth = Cells(1, 1) & "月" 'tgtMonthに指定月を格納
refPath = "C:\Users\mtkbirdman\Desktop\ひつじマクロ" 'share勤務表が格納されているフォルダパス★
Set RefWb = Workbooks.Open(fileName:=refPath & "\改_勤務表_名前.xlsx", Password:="0908") 'RefWbに関数の戻り値(share勤務表のファイルオブジェクト)を格納する、開いてもいる★
Set sht0 = RefWb.Worksheets(tgtMonth) 'sht0に関数の戻り値(＝指定月)を格納
existFlag = False 'フラグをFALSEに初期化する
For Each sht1 In ThisWorkbook.Worksheets 'ローカルファイルの全シートを１つずつループして処理する
'指定月のシートが存在するかどうか調べる
If sht1.Name = tgtMonth Then existFlag = True '指定月のシートが存在していたらexistFlagをTrueにする
Next
If Not existFlag Then '指定月のシートが存在していない
ThisWorkbook.Sheets("雛形").Copy After:=ThisWorkbook.Sheets("取得") '雛形シートのコピーを取得シートの後ろに作成する
ThisWorkbook.Worksheets("雛形 (2)").Name = tgtMonth 'シート名を指定月にする
End If
sht0.Range(sht0.Cells(1, 1), sht0.Cells(34, 10)).Copy 'share勤務表の指定月シートの入力領域をコピーする★
Set sht1 = ThisWorkbook.Worksheets(tgtMonth) 'sht1に指定月シートを格納する
sht1.Activate '指定月シートをアクティブにする
sht1.Cells(1, 15).Select '貼り付けるセルを選択する★
ActiveSheet.Paste '貼り付ける
sht1.Range("A1").Select '最後にA1セルを選択しておく（好み）
RefWb.Close 'share勤務表のファイルオブジェクトを閉じる
ActiveWorkbook.Save 'このファイルを保存
Call Googleカレンダー予定取得マクロ_エクスポート版
End Sub
↓Googleカレンダー取得マクロ
Sub Googleカレンダー予定取得マクロ_エクスポート版()
'このコードを実行するためには、参照設定で「Microsoft Shell Controls And Automation」を有効にする必要があります。具体的な手順はExcelのバージョンにより異なるため、詳細はExcelのヘルプをご参照ください。また、VBAの実行にはセキュリティ上のリスクが伴うため、信頼できるソースからのコードのみを実行するようにしてください。
'VBE>ツール>参照設定※ファイルごとに設定される
Dim zipPath As String '文字列型のオブジェクト（＝解凍すべきzipファイルのパス）を宣言
Dim refPath As String '文字列型のオブジェクト（＝参照する.icファイルの格納フォルダ）を宣言
Dim fileName As String '文字列型のオブジェクト（＝参照する.icsファイル名）を宣言
Dim fileName2 As String '文字列型のオブジェクト（＝参照する.icファイルの文字コード更新版ファイル名）を宣言
Dim FileContent As String '文字列型のオブジェクト（＝参照する.icsファイルの読み取り行）を宣言
Dim getYear As String '文字列型のオブジェクト（＝指定の年）を宣言
Dim getMonth As String '文字列型のオブジェクト（＝指定の月）を宣言
Dim FileNumber As Integer '整数型のオブジェクト（＝ファイルを開くときに使う一次的な管理番号）を宣言
Dim RowNumber As Integer '整数型のオブジェクト（＝Excelに取得データを書き込むときの行番号）を宣言
Dim ContentName As String '文字列型のオブジェクト（＝参照する.icsファイルの各行の「：」から前の項目名）を宣言
Dim Content As String '文字列型のオブジェクト（＝参照する.icsファイルの各行の「：」から後ろの項目名）を宣言
Dim ContentDate As Date '日付型のオブジェクト（＝参照する.icsファイルの日付を世界標準時から日本時間に置き換えたもの）を宣言
Dim getFlag As Boolean 'ブール型の真偽値（＝指定の年月内で取得すべきデータの行）を宣言
Dim sht1 As Worksheet 'ワークシート型のオブジェクト（＝給与計算シート）を宣言
Dim tgtMonth As String
' ファイルパスを指定
zipPath = "C:\Users\mtkbirdman\Desktop\ひつじマクロ\mtk_birdman@yahoo.co.jp.ical.zip" '解凍すべきzipファイルのパス★
refPath = "C:\Users\mtkbirdman\Desktop\ひつじマクロ" & "\Googleカレンダー_エクスポート" 'エクスポートした.icsファイルの格納フォルダ（解凍後）★
fileName = "mtk_birdman@yahoo.co.jp.ics" 'エクスポートした.icsファイル名★
fileName2 = WorksheetFunction.Substitute(fileName, ".ics", "_ShiftJIS.ics") 'エクスポートした.icsファイルの文字コードを変換したファイル名
' 年と月を指定
getYear = ThisWorkbook.Sheets("取得").Cells(2, 1)
getMonth = ThisWorkbook.Sheets("取得").Cells(1, 1)
tgtMonth = getMonth & "月" '給与計算のシート名
Set sht1 = ThisWorkbook.Worksheets(tgtMonth) 'sht1に指定月シートを格納する
'予定の貼り付け列を白紙にする
sht1.Range("AE:AI").ClearContents
'ヘッダー情報を追加する
With sht1
.Range("AE1") = "開始日"
.Range("AF1") = "開始時刻"
.Range("AG1") = "終了日"
.Range("AH1") = "終了時刻"
.Range("AI1") = "タイトル"
End With
' Excelの行番号を初期化
RowNumber = 2
Dim command As String '文字列型の変数（＝PowerShellコマンド）を宣言
Dim shell As Object 'オブジェクト型のオブジェクト（＝立ち上げたパワーシェル）を宣言
Set shell = CreateObject("WScript.Shell") ' WScript.Shellオブジェクトを作成
command = "powershell -NoProfile -ExecutionPolicy Unrestricted Expand-Archive -Path " & zipPath & " -DestinationPath " & refPath & " -Force" 'zipファイル解凍用のコマンド
shell.Run command, 0, True ' PowerShellコマンドを実行（引数：実行する文字列,PowerShell画面の表示(1)/非表示(0),PowerShell実行完了を待つ(True)/待たない(False)）
command = "powershell -Command ""Get-Content -Encoding UTF8 """ & refPath & "\" & fileName & """ | Out-File -Encoding default """ & refPath & "\" & fileName2 & """" '文字コード変換用のコマンド
shell.Run command, 0, True ' PowerShellコマンドを実行（引数：実行する文字列,PowerShell画面の表示(1)/非表示(0),PowerShell実行完了を待つ(True)/待たない(False)）
Set shell = Nothing 'オブジェクト（＝立ち上げたパワーシェル）をリセット
'.icsファイルを開く
FileNumber = FreeFile '一次的な管理番号に空き番を格納
Open refPath & "\" & fileName2 For Input As #FileNumber '参照する.icsファイルに空き番を割り当てる
'.icsファイルを読み込む
Do Until EOF(FileNumber) 'ファイルの最後（End of File）までループを回す
Line Input #FileNumber, FileContent
'「:」を含む行は項目名と中身の2つに分割し、「:」を含まない行は処理からはじく
If InStr(FileContent, ":") Then
ContentName = Split(FileContent, ":")(0)
Content = Split(FileContent, ":")(1)
Else
ContentName = ""
Content = ""
End If
'項目名に「DT」を含む行は世界標準時から日本時間に変換する
If InStr(ContentName, "DT") Then ContentDate = ConvertUTCToJST(Content)
' イベントの開始日時を取得
If InStr(ContentName, "DTSTART") Then
If Year(ContentDate) = getYear And Month(ContentDate) = getMonth Then
sht1.Cells(RowNumber, 31).Value = Format(ContentDate, ShortDate)
If Len(Content) > 9 Then sht1.Cells(RowNumber, 32).Value = Format(ContentDate, ShortTime)
getFlag = True
End If
End If
' イベントの終了日時を取得
If InStr(ContentName, "DTEND") And getFlag Then
sht1.Cells(RowNumber, 33).Value = Format(ContentDate, ShortDate)
If Len(Content) > 9 Then sht1.Cells(RowNumber, 34).Value = Format(ContentDate, ShortTime)
End If
' イベントの題名を取得
If InStr(ContentName, "SUMMARY") And getFlag Then
sht1.Cells(RowNumber, 35).Value = Content
RowNumber = RowNumber + 1
getFlag = False
End If
Loop
' ファイルを閉じる
Close #FileNumber
ThisWorkbook.Save
End Sub
Function ConvertUTCToJST(utcTime As String) As Date
'この関数は、UTC時間を表す文字列を引数に取り、日本標準時を返します。DateSerial関数とTimeSerial関数を使用して、文字列をDate型に変換し、DateAdd関数を使用して、時間を9時間進めて日本標準時に変換しています。
Dim utcDate As Date
Dim jstDate As Date
' UTC時間をDate型に変換
utcDate = DateSerial(Mid(utcTime, 1, 4), Mid(utcTime, 5, 2), Mid(utcTime, 7, 2))
If Len(utcTime) > 9 Then utcDate = utcDate + TimeSerial(Mid(utcTime, 10, 2), Mid(utcTime, 12, 2), Mid(utcTime, 14, 2))
' UTC時間を日本標準時に変換（9時間進める）
jstDate = utcDate
If Len(utcTime) > 9 Then jstDate = DateAdd("h", 9, utcDate)
ConvertUTCToJST = jstDate
End Function
↓顧客情報取得マクロ
Sub main()
'最新の顧客担当を担当別シートに出力するマクロ
Dim refPath As String '文字列型のオブジェクト（＝参照先フォルダパス）を宣言する
Dim refWb As Workbook 'ワークブック型のオブジェクト（＝参照先ファイル）を宣言する
Dim refSht As Worksheet 'ワークシート型のオブジェクト（＝参照先シート）を宣言する
Dim oldSht As Worksheet 'ワークシート型のオブジェクト（＝削除するシート）を宣言する
Dim newSht As Worksheet 'ワークシート型のオブジェクト（＝担当者別シート）を宣言する
Dim currentPerson As String '現担当者名
Dim newPerson As String '新担当者名
Dim existFlag As Boolean 'その担当者のシートが当Excelブックに既に存在しているかどうかのフラグ TRUE:存在している、FALSE：存在していない
Dim nRow As Long '行数
Dim num As Long 'ループのカウンタ
With Application
'警告や確認のメッセージを非表示に設定
.DisplayAlerts = False
'シート名をチェックして、取得マクロシートでなければ削除
For Each oldSht In ThisWorkbook.Worksheets
If oldSht.Name <> "取得" Then
oldSht.Delete
End If
Next
'警告や確認のメッセージ表示設定を元に戻す
.DisplayAlerts = True
End With
refPath = "C:\Users\mtkbirdman\Desktop\ひつじマクロ" '★参照先のエクセルファイルのフォルダのパスを設定★
Set refWb = Workbooks.Open(Filename:=refPath & "\改_参照される顧客情報ファイル.xlsx") '参照先のファイルを開く★
' 参照先ファイルの全シートを 1 つずつループして処理する
For Each refSht In refWb.Worksheets
'不要なシートを参照範囲から除外する
If Not refSht.Name = "給与" Then
If Not refSht.Name = "Sheet1" Then
'上から順番に顧客情報を参照していく
num = 0 'Do whileのカウンタを初期化する
Do While refSht.Cells(3 + 5 * num, 3) <> "" '★現担当者名のセルが空白でないなら
currentPerson = refSht.Cells(3 + 5 * num, 3) '★現担当者の名前を取得する
existFlag = False 'フラグをFALSEに初期化する
For Each newSht In ThisWorkbook.Worksheets 'ローカルファイルの全シートを１つずつループして処理する
'現担当者名のシートが存在するかどうか調べる
If newSht.Name = currentPerson & "さん" Then existFlag = True '現担当者名のシートが存在していたらexistFlagをTrueにする
Next
If Not existFlag Then '現担当者名のシートが存在していない
Set newSht = ThisWorkbook.Sheets.Add() 'ローカルファイルに現担当者のシートを追加する
newSht.Name = currentPerson & "さん" 'シート名を現担当者名にする
'ヘッダー情報を追加する
With newSht
.Cells(1, 1) = newSht.Name
.Cells(1, 1).Font.Size = 14
.Cells(1, 1).Font.Bold = True
.Cells(2, 1) = "ｺｰﾄﾞ"
.Cells(2, 2) = "顧客名"
.Cells(2, 3) = "ﾗﾝｸ"
.Cells(2, 4) = "新担当"
.Cells(2, 5) = "時期"
.Range("A2:E2").Borders(xlEdgeBottom).LineStyle = xlDouble
End With
End If
Set newSht = ThisWorkbook.Worksheets(currentPerson & "さん") '現担当者のシートをnewShtに格納する
'顧客情報を貼り付けるベき行を取得する
nRow = newSht.Cells(Rows.Count, "A").End(xlUp).Row + 1
newSht.Cells(nRow, 1) = refSht.Cells(3 + 5 * num, 1)
newSht.Cells(nRow, 2) = refSht.Cells(3 + 5 * num, 2)
newSht.Cells(nRow, 3) = refSht.Cells(5 + 5 * num, 1)
newSht.Cells(nRow, 4) = refSht.Cells(3 + 5 * num, 4)
newSht.Cells(nRow, 5) = refSht.Cells(3 + 5 * num, 5)
newSht.Activate
newSht.Range("A1").Select '最後にA1セルを選択しておく（好み）
num = num + 1 'Do whileのカウンタを更新する→次の顧客情報へ
Loop '参照先のファイルの顧客情報のループ
'すべての顧客情報をコピペし終わったら次のシートへ
End If
End If
Next '参照先ファイルの全シートのループ
' 参照先ファイルの全シートを 1 つずつループして処理する
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> "取得" Then
With sht
a = .Cells(Rows.Count, "A").End(xlUp).Row '最終行を取得する
b = .Cells(2, Columns.Count).End(xlToLeft).Column '最終列を取得する
c = .Range(.Cells(1, 1), .Cells(a, b)).Address 'アドレスを取得する
.PageSetup.PrintArea = c '印刷範囲を設定
End With
sht.Activate
Columns("A").ColumnWidth = 5
Columns("B").ColumnWidth = 20
Columns("C").ColumnWidth = 5
Columns("D").ColumnWidth = 6
Columns("E").ColumnWidth = 5
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 100
With ActiveSheet.PageSetup
.LeftMargin = Application.CentimetersToPoints(0.5)
.RightMargin = Application.CentimetersToPoints(0.5)
.TopMargin = Application.CentimetersToPoints(0.5)
.BottomMargin = Application.CentimetersToPoints(0.5)
.HeaderMargin = Application.CentimetersToPoints(0)
.FooterMargin = Application.CentimetersToPoints(0)
End With
End If
Next '参照先ファイルの全シートのループ
refWb.Close '参照先のファイルを閉じる
ThisWorkbook.Save 'このファイルを保存する
End Sub