Excelのひな形に
・指定の日付
・宛名と住所電話番号、取引先コード
を 入れて名前を付けて保存する（ループで人数分）
※名簿はCSVで保存されている
※あたらしいブックに保存する際はSavePath & "\" & SaveName &とし
指定のフォルダに保存させている
※フォルダ構成は以下の画像の通り
//名簿.csvは各フォルダには存在せず親フォルダに存在する
//雑感：本当はListbook1で選択した人だけファイルを作る
というロジックを考えていたのだが、複数選択可能な
Listboxの選択項目自体を配列とすることは
私の実力では不可能だった。
というわけで、とりあえずグループ全員分をつくり
いらないものは手動で消すという方法とした。
ここが心残りでした。
参考画像：...作成ボタンを押すと以下のコードが発動するしくみ。
Private Sub CommandButton2_Click()
'？？書の作成
Dim myPath, mySubPath, YearFolder As String
Dim Filename, ListBox1 As String
Dim bk As Workbook
Dim myDay As String
Dim wbNew As String
'On Error Resume Next
'自身以外のworkbooksを閉じる
For Each bk In Workbooks
If Not (bk Is ThisWorkbook) Then
bk.Close SaveChanges:=False
End If
Next
myPath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1) & "\" '親パスのフルパス
'myPath = ThisWorkbook.Path & "\" '自分自身のフルパス
mySubPath = myPath & "請求書-ひな形" & "\"
Filename = UserForm1.ComboBox3 & ".xls"
If UserForm1.ComboBox3 = "" Then
MsgBox "様式を選択してください"
Exit Sub
Else
Workbooks.Open mySubPath & Filename
ActiveWindow.SelectedSheets.Copy
wbNew = ActiveWorkbook.Name
End If
Dim flag As Boolean
flag = False
Dim trgtFileName As String
trgtFileName = myPath & "\" & "名簿.csv"
' ワークブックオブジェクトを定義する
Dim wb As Workbook
'開いている全ブックにループ処理を実行する
For Each wb In Workbooks
' ブックの名前が目的のブック名と一致した場合､処理を実行
If wb.Name = trgtFileName Then
' フラグをTrueにしてループを抜ける
flg = True
Exit For
End If
Next
'フラグがFalseだった場合､ブックを開く
If flg = False Then
Workbooks.Open trgtFileName
End If
Set wb = Nothing
'invoiceday----
Dim myDayStr, ggg, e, mm, dd As String
myDay = Format(Date, "gggemmdd")
myDayStr = CStr(myDay)
ggg = StrConv(Left(myDay, 2), vbWide)
e = StrConv(Mid(myDay, 3, 1), vbWide)
mm = StrConv(Mid(myDay, 5, 1), vbWide)
dd = StrConv(UserForm1.ComboBox4.Value, vbWide)
invoiceday = ggg & " " & e & "年" & " " & mm & "月" & " " & dd & "日"
'--------------
Dim LastRow As Integer
Dim MyRange As Range
Dim FirstCell As Range
Dim Str As String
Dim myFind, SavePath, SaveName As String
LastRow = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
SavePath = myPath & "2024-Excel" & "\" & UserForm1.ComboBox2.Value & "月"
SaveName = Format(Date, "yyyy") & "年" & UserForm1.ComboBox2.Value & "月" & " " & "？？書 "
myFind = UserForm1.ComboBox3.Value
Set MyRange = ActiveWorkbook.Worksheets(1).Range(Cells(1, 5), Cells(LastRow, 8)).Find(what:=myFind, LookAt:=xlPart)
If MyRange Is Nothing Then
Debug.Print "みつかりません"
Exit Sub
Else
Set FirstCell = MyRange
End If
Do
' Str = Str & Cells(MyRange.Row, 1).Value & Cells(MyRange.Row, 2).Value & Cells(MyRange.Row, 3).Value & Cells(MyRange.Row, 4).Value & vbLf
Workbooks(wbNew).Activate
With ActiveWorkbook.Worksheets(1)
Range("N2").Value = Workbooks("名簿.csv").Worksheets(1).Cells(MyRange.Row, 4).Value 'T_no
Range("M4").Value = invoiceday
Range("O6").Value = Workbooks("名簿.csv").Worksheets(1).Cells(MyRange.Row, 2).Value 'Adress
Range("O7").Value = Workbooks("名簿.csv").Worksheets(1).Cells(MyRange.Row, 3).Value 'tel
Range("O8").Value = Workbooks("名簿.csv").Worksheets(1).Cells(MyRange.Row, 1).Value 'name
Peopele = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 1).Value
End With
ActiveWorkbook.SaveAs SavePath & "\" & SaveName & Left(Peopele, 2) & ".xlsx"
ActiveWorkbook.Close
Workbooks(2).Activate
ActiveWindow.SelectedSheets.Copy
wbNew = ActiveWorkbook.Name
Workbooks(3).Activate
MyRange.Select
Set MyRange = Cells.FindNext(MyRange)
If FirstCell.Address = MyRange.Address Then Exit Do
Loop
' Debug.Print Str
'自身以外のworkbooksを閉じる
For Each bk In Workbooks
If Not (bk Is ThisWorkbook) Then
bk.Close SaveChanges:=False
End If
Next
Set bk = Nothing
Set myPath = Nothing
Set mySubPath = Nothing
YearFolder = ""
Filename = ""
myDay = ""
wbNew = ""
myDayStr = ""
ggg = ""
e = ""
mm = ""
dd = ""
myDay = ""
myDayStr = ""
LastRow = 0
Set MyRange = Nothing
Set FirstCell = Nothing
Set myFind = Nothing
SavePath = ""
SaveName = ""
Unload Me
End Sub
