ブック シート新ブック保存
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Public Function fncシート新ブック保存(TagetBook As Workbook, TagetSheet As Worksheet, FolPath As String, ファイル名 As String) As String '******************************************************************************* '指定シートを新しいブックに保存（指定フォルダへ）必ずシート名は[Sheet1]にする '保存後そのパスとファイル名を返す '******************************************************************************* Dim NewBook As Workbook, strName As String, NewSheet As Worksheet strName = 保存名作成 Set NewBook = Workbooks.Add Dim i, cnt As Integer cnt = NewBook.Sheets.Count For i = 1 To cnt If NewBook.Sheets(i).Name = "Sheet1" Then NewBook.Sheets(i).Name = "Sheet0" Exit For End If Next TagetSheet.Copy Before:=NewBook.Sheets(1) Set NewSheet = NewBook.Sheets(1) NewSheet.Name = "Sheet1" Call シート削除(NewBook, "Sheet0") NewBook.SaveAs Filename:= _ FolPath & "\" & ファイル名 & "_" & strName & ".xls", FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False NewBook.Close Set NewSheet = Nothing Set NewBook = Nothing fncシート新ブック保存 = FolPath & "\" & ファイル名 & "_" & strName & ".xls" End Function |