Excel2003のVBAでエクセルファイルとして保存
こんにちわ。
Excel2003のVBAで、シート1に採点用のフォーマットを作成し、採点ボタンを押したら別の場所(フォルダ)に別のファイル(.xls形式)として採点結果を保存したいと考えています。過去に似たような質問があったのでそれを参考にしたのですが、コードの意味がほとんど分かりません。下記のコードで実行したところ、エラーが出てしまいます。どこが悪いのか教えていただけないでしょうか?
エラー箇所は
BkName = OldWkbook.Sheets(StName1).Range("K1").Value
です。”インデックスが有効範囲にありません”と表示されます。
例)
Dim FileName As String
Dim FileExt As String
Dim BkName As String
Dim OldWkbook As Workbook
Dim NewWkbook As Workbook
Const StName1 As String = "ko"
'
Application.DisplayAlerts = False
Set OldWkbook = ActiveWorkbook
'
'ファイル名を取得
BkName = OldWkbook.Sheets(StName1).Range("K1").Value
FileName = BkName & Format(Now, "yyyy-mm") & ".XLS"
'
FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName)
If FileName = "" Then
Exit Sub
Else
If Right(FileName, 4) <> ".XLS" Then
MsgBox "ファイル名が異常です。"
Exit Sub
End If
End If
'
OldWkbook.Sheets(Array(StName1)).Copy
Set NewWkbook = ActiveWorkbook
'シートの保護を解除
Worksheets("sheet1").Unprotect
For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1
If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除
NewWkbook.Sheets(1).Shapes(wIx).Delete '←1ではなくwIxです
End If
Next
NewWkbook.Sheets(1).Name = StName1
'
FileName = "D:\保存\計画\" & FileName
'
If Dir(FileName) <> "" Then
'##ファイルが既に存在する
If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then
NewWkbook.Close savechanges:=False
'##保存せずに終了
Exit Sub
End If
'##指定ファイル置き換え保存
NewWkbook.SaveAs FileName:=FileName
Else
'##ファイルを新規保存
NewWkbook.SaveAs FileName:=FileName
End If
'
NewWkbook.Close savechanges:=False
Application.DisplayAlerts = True
End Sub
お礼
詳しくありがとうございました! よくわかったし、できました!!! 本当にありがとうございました。