梅雨でジメジメの蒸し暑暑ですが元気に行きましょう。寒いより暑いほうが好きです。
今回もまたExcelVBAで芸がないのですが、30分考えたので書き起こします。
そもそもあるシートを新規ブックとして起動させるには、
Dim sht as WorkSheet Set sht = ThisWorkbook.Worksheets("対象のシート") sht.Copy
これだけ。
対象シートが非表示の場合、Copyメソッドが失敗しますので、
ブックの保護解除とシートの可視化も導入
Dim sht as WorkSheet Set sht = ThisWorkbook.Worksheets("対象のシート") ThisWorkbook.Unprotect Password:=BKPWD sht.Visible = True sht.Copy sht.Visible = False ThisWorkbook.Protect Password:=BKPWD
この新規ブックを別名で保存するには、CopyするとWorkBooksがAddされたのと同じ状態になりますので、
'' 最後のブックを別名で保存 Workbooks(Workbooks.Count).SaveAs newFileNm, FileFormat:=xlNormal
します。ActiveWorkBookでもいいですが、Copyの後にActiveが動くような事があると・・・
というわけで全体のコードはこんな感じ。CSV形式での保存も対応しています。
Sub SaveAsOtherName Dim newName As String newName = _ Application.GetSaveAsFilename( _ InitialFileName:="デフォのファイル名" _ , FileFilter:="エクセルファイル(*.xls),*.xls" & _ ",CSVファイル(*.csv),*.csv" _ , FilterIndex:=1 _ , Title:="保存先の指定" _ ) If newName = "FALSE" Then Exit Sub If Dir(newName) <> "" Then If MsgBox("同名のファイルが存在します。上書きしてもよろしいですか?", Title:=MSGBOX_TITLE, Buttons:=vbYesNo) <> vbYes Then Exit Sub End If End If Dim sht As Worksheet: Set sht = ThisWorkbook.Worksheets("コピー対象シート名") ThisWorkbook.Unprotect Password:=BKPWD sht.Visible = True sht.Copy sht.Visible = False ThisWorkbook.Protect Password:=BKPWD Application.DisplayAlerts = False '' 新ファイル名称の拡張子で保存形式を判定しています。 If CheckExtension("xls", newName) Then Workbooks(Workbooks.Count).SaveAs newName, FileFormat:=xlNormal Else Workbooks(Workbooks.Count).SaveAs newName, FileFormat:=xlCSV End If ActiveWorkbook.Close Application.DisplayAlerts = True MsgBox "保存しました", Title:=MSGBOX_TITLE End Sub
divirta-se!
0 件のコメント:
コメントを投稿