こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBAでシートの保護

初めまして。
私はWindowsXP、Excel2003のVBAでシートの保護、またそれの解除のコードを組んだのですが、以下のコードでは「○○○と言う名前で保存します。よろしければこのままOKをクリックしてください」の箇所でキャンセルを選択した時に、シートの保護を行いたいのですが、どのようなコードにすればよいてのでしょうか?
例)
  Dim FileName As String
Dim FileExt As String
Dim BkName1 As String
Dim BkName2 As String
Dim BkName3 As String
Dim OldWkbook As Workbook
Dim NewWkbook As Workbook
Const StName1 As String = "適材適所グラフ"
Const StName2 As String = "適材適所回答"
Const StName3 As String = "適性検査III回答"
Const StName4 As String = "適性検査IIIグラフ"


'シートの保護を解除
Worksheets("適性検査III回答").Unprotect
Worksheets("適材適所回答").Unprotect

Application.DisplayAlerts = False
Set OldWkbook = ActiveWorkbook
'
'ファイル名を取得
BkName1 = OldWkbook.Sheets(StName3).Range("L1").Value
BkName2 = OldWkbook.Sheets(StName3).Range("L2").Value
BkName3 = OldWkbook.Sheets(StName3).Range("L3").Value

FileName = BkName1 & Format(".") & BkName2 & Format(".") & BkName3 & ".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, StName2, StName3, StName4)).Copy


Set NewWkbook = ActiveWorkbook



'ボタンを削除
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
End If
Next



NewWkbook.Sheets(1).Name = StName1

'コピー先シートの保護
Sheets(1).Protect
Sheets(2).Protect
Sheets(3).Protect
Sheets(4).Protect

FileName = "C:\採点結果\" & 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

'シートの保護
Worksheets("適性検査III回答").Protect
Worksheets("適材適所回答").Protect

End Sub

投稿日時 - 2008-09-22 10:24:07

QNo.4347640

すぐに回答ほしいです

質問者が選んだベストアンサー

Const StName1 As String = "適材適所グラフ"
Const StName2 As String = "適材適所回答"
Const StName3 As String = "適性検査III回答"
Const StName4 As String = "適性検査IIIグラフ"

'シートの保護を解除
Worksheets("適性検査III回答").Unprotect    '←これを削除しましたか?
Worksheets("適材適所回答").Unprotect     '←これを削除しましたか?

Application.DisplayAlerts = False
Set OldWkbook = ActiveWorkbook


一番上の保護を解除を削除しても変わりがないなら、手動でシートを保護してブックを保存してから
実行してください。
どうしてもVBAで保護したいなら、以下のように追加してください。

FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName)
If FileName = "" Then
  Worksheets("適性検査III回答").protect    '←これを追加
  Worksheets("適材適所回答").protect     '←これを追加
  Exit Sub
Else
  If Right(FileName, 4) <> ".xls" Then
    MsgBox "ファイル名が異常です。"
    Worksheets("適性検査III回答").protect    '←これを追加
    Worksheets("適材適所回答").protect     '←これを追加
    Exit Sub
  End If
End If

投稿日時 - 2008-09-22 13:01:54

お礼

できました!!
ありがとうございます。

投稿日時 - 2008-09-22 13:13:25

ANo.4

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

おはようございます。
シートの保護解除を以下のように移動してみてください。

Application.DisplayAlerts = False
Set OldWkbook = ActiveWorkbook
'
'ファイル名を取得
BkName1 = OldWkbook.Sheets(StName3).Range("L1").Value
BkName2 = OldWkbook.Sheets(StName3).Range("L2").Value
BkName3 = OldWkbook.Sheets(StName3).Range("L3").Value
'
FileName = BkName1 & Format(".") & BkName2 & Format(".") & BkName3 & ".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

Worksheets("適性検査III回答").Unprotect   '←上からここに移動する
Worksheets("適材適所回答").Unprotect    '←上からここに移動する

OldWkbook.Sheets(Array(StName1, StName2, StName3, StName4)).Copy

投稿日時 - 2008-09-22 10:59:00

補足

ご回答ありがとうございます。

Worksheets("適性検査III回答").Unprotect   '←上からここに移動する
Worksheets("適材適所回答").Unprotect    '←上からここに移動する
このコードを入力した実行したのですが、変わりませんでした・・。

投稿日時 - 2008-09-22 12:46:38

ANo.2

ANo.1です。

回答ではないですが、どこかで見たこのとあるコードと思ったのですが、
Excel2003のVBAでエクセルファイルとして保存
http://okwave.jp/qa4337790.html
こちらでしたか。

投稿日時 - 2008-09-22 10:44:24

補足

そうです。
キャンセルしたときにシート保護がされていないことに気づいたので・・。

投稿日時 - 2008-09-22 12:41:22

ANo.1

InputBox 関数ではなく、InputBox メソッドを使用してみては?

例)
Dim v As String
v = Application.InputBox("OOO")
MsgBox v

InputBox メソッドのヘルプより
[キャンセル] ボタンをクリックすると、False が返されます。

上記なら変数vが"False"であれば「キャンセル」された事になりますので、そこを判断基準としてはどうでしょうか。

投稿日時 - 2008-09-22 10:38:37

補足

ご回答ありがとうございます。
せっかく答えていただいたのに申し訳ないのですが・・
どの部分に例のコードを入れればよろしいのですか?

投稿日時 - 2008-09-22 11:50:14

あなたにオススメの質問