| |
こんにちは、よろしくお願いします。
作成したファイルを年度末に前年分として
ﾏｸﾛを抜いたファイルとして保存したくて下記コードを書きました。
（恥ずかしながら殆どコピペです）
問題なのは 下記コードで・・・問題と書いてある部分です。
これは私が足しました。
arrayの部分の"さしすせそ" & smonth & "月" も私が足しました。
本ブックにはさしすせそ4〜3月のシートがあるのですが、これが非固定です。
4月しかないこともあれば、4〜3月までびっちりある場合もある。
4,5,7,8,12のように飛び飛びのこともあります。
下記のように書くと、
WBK1.Worksheets(tblSH).Copy
の部分でエラーになります。
解りにくいかもしれませんが、正しいコードをご教示いただけないでしょうか
Private Sub CommandButton17_Click()
Const cnsTITLE = "マクロなしブックの作成"
Const cnsFILTER = "Excelワークブック (*.xls),*.xls"
Dim xlAPP As Application
Dim WBK1 As Workbook ' 本ブック
Dim WBK2 As Workbook ' 作成ブック
Dim objVBCOMPO As Object
Dim strFILENAME As String
Dim tblSH As Variant
Dim lngLines As Long
Dim smonth As Long
smonth = 1 Or 2 Or 3 Or 4 Or 5 Or 6 Or 7 Or 8 Or 9 Or 10 Or 11 Or 12・・・問題
tblSH = Array("あいう", "あいうえ", "あいうえお", "かきく", "かきくけ", "かきくけこ", "さしす", "さしすせ", "さしすせそ" & smonth & "月")
Set xlAPP = Application
Set WBK1 = ThisWorkbook
xlAPP.StatusBar = "出力するファイル名を指定して下さい。"
strFILENAME = xlAPP.GetSaveAsFilename(InitialFileName:="データ年度.xls", _
FileFilter:=cnsFILTER, Title:=cnsTITLE)
If StrConv(strFILENAME, vbUpperCase) = "FALSE" Then Exit Sub
If strFILENAME = WBK1.FullName Then
MsgBox "本ブックとは違うファイル名を指定して下さい。", , cnsTITLE
GoTo MAKE_NEWBOOK_WO_MACROS_EXIT
End If
WBK1.Worksheets(tblSH).Copy
Set WBK2 = ActiveWorkbook
For Each objVBCOMPO In WBK2.VBProject.VBComponents
With objVBCOMPO.CodeModule
lngLines = .CountOfLines
If lngLines <> 0 Then .DeleteLines 1, lngLines
End With
Next objVBCOMPO
WBK2.SaveAs Filename:=strFILENAME
WBK2.Close False
Set WBK2 = Nothing
MAKE_NEWBOOK_WO_MACROS_EXIT:
Set WBK1 = Nothing
Set xlAPP = Nothing
Unload Me
End Sub
|
|
かかこ
- 11/10/18(火) 11:25 -
