最後の質問!

力が無いくせにチャレンジし後に引けなくなりました。
どうか皆様のお知恵拝借したく宜しくお願い致します。

コメント欄のコードを見て下さい。

ファイルは常にシートの保護がかかっている状態(またはマクロが動作し終わった後も保護がかかる状態)ということを念頭に置いておいて下さい。

やりたいこと
 
1)タイムカードのシートはこの内容でもマクロ開始前・開始後もきちんとシートの保護がかかった状態になりますが、
  業務報告書のシートに、シートの保護をかけると、
  業務報告シートに移った途端動かない・または不明な動作をする。
  業務報告書のシートにあらかじめシートの保護がかかった状態でも、マクロが動作し、尚且つマクロを動かした後でも
  業務報告シートに、シートの保護がかかっている状態にする。

2)ファイル名を変えても何ら問題なくマクロが動くようにしたい。
  (これは何ら問題ないとは思いますが念の為に書いておきます)

お願い致します。
結果、全てできた場合、ポイントははずみます。

回答の条件
  • 1人1回まで
  • 登録:2009/05/18 18:03:37
  • 終了:2009/05/19 11:35:15

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912009/05/18 20:42:30

ポイント200pt

質問に対する回答としては、シート保護に関して処理の前後に書かなくとも ThisWorkbook の下に

    ActiveSheet.Unprotect Password:="1111"
    ActiveSheet.Protect Password:="1111", DrawingObjects:=True, contents:=True, UserInterfaceOnly:=True

と書いておくことで、

・マクロを無効にした場合シート保護がかかった状態のままとなる。

・ファイルをどのタイミングで終了しても(途中・保存してもしなくても)、シートに保護がかかった状態になる。

ことが実現されます。

(標準モジュールからはProtect、Unprotectの記述を削除します。)



回答としては直接関係ありませんが、下記にコメントされたコードの不要な部分をまとめると次のようになります。

Sub ClearAll()
    ActiveSheet.Range("B2,D2,D8:F38").ClearContents
    Sheets("ジョブ№").Cells.ClearContents
    Sheets("タイムカード").Range("B2,D2,D8:F38").ClearContents

    With Sheets("業務報告書")
        Range("A12:A51,D12:D51,AI12").ClearContents
        With Range("A12:A51,D12:D51")
            With .Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            .Borders(xlInsideHorizontal).Weight = xlHairline
            .Interior.ColorIndex = 35
        End With
End Sub

Sub データ消去()
    If vbYes = MsgBox("すべてクリアしてもいいですか?", vbYesNo, "確認") Then
        ClearAll
    End If
End Sub

Private Sub CommandButton1_Click()
    ThisWorkbook.Saved = True
    ThisWorkbook.Close
End Sub

Sub CloseFile()
    If MsgBox("上書きをしてもいいですか", vbYesNo) = vbYes Then
        ThisWorkbook.Save
    Else
        ThisWorkbook.Saved = True
    End If
    ThisWorkbook.Close
End Sub

ただし、先頭の

  ActiveSheet.Range("B2,D2,D8:F38").ClearContents

はデータ消去を実行した(そのトリガとなるボタンがある)ときにアクティブなシートが対象になりますので、

  Sheets(シート名).Range("B2,D2,D8:F38").ClearContents

と修正したほうがよいでしょう。

もしこれが「タイムカード」シートであるなら、記述自体2重になっているので不要となります。


http://officetanaka.net/excel/vba/speed/s2.htm

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_030_090.html

id:msvista

ありがとうございます。

ws.Unprotect Password:="1111"

このコマンドを使うとデバックは中断します。

と表示されます。

またファイルを開くとパスワードが違いますと表示されます。

パスワードは全て”1111”なのですが。

ちなみに複数のシートに、シートの保護をかけたいので

コメント欄の内容を試しています。

あと一歩なのですが・・・

2009/05/19 10:07:19
  • id:msvista
    Sub Macro1()
    '
    ' Macro1 Macro
    ' マクロ記録日 : 2009/5/18 ユーザー名 :
    '
    ActiveSheet.Unprotect Password:="1111"
    '
    Sheets("ジョブ№").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("タイムカード").Select
    Range("B2").Select
    Selection.ClearContents
    Range("D2").Select
    Selection.ClearContents
    Range("D8:F38").Select
    Selection.ClearContents
    Range("B2").Select

    Sheets("業務報告書").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("A12:A51").Select
    Selection.ClearContents
    Range("D12:D51").Select
    Selection.ClearContents
    Range("E12:AI51").Select
    Range("AI12").Activate
    Selection.ClearContents
    Range("A12:A51").Select
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlHairline
    .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlHairline
    .ColorIndex = xlAutomatic
    End With
    Range("D12:D51").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlHairline
    .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlHairline
    .ColorIndex = xlAutomatic
    End With
    Range("A12:A51").Select
    Selection.Interior.ColorIndex = 35
    Range("D12:D51").Select
    Selection.Interior.ColorIndex = 35
    Range("A6").Select
    Sheets("タイムカード").Select
    Range("B2").Select
    Selection.ClearContents

    ActiveSheet.Protect Password:="1111", DrawingObjects:=True, _
    contents:=True, UserInterfaceOnly:=True
    End Sub

    Sub データ消去()
    '
    ' データ消去
    ' マクロ記録日 : 2009/5/15 ユーザー名 :
    'Private Sub CommandButton1_Click()

    If 6 = MsgBox("すべてクリアしてもいいですか?", 4 + 0 + 256, "確認") Then

    '
    Range("B2").Select
    Selection.ClearContents
    Range("D2").Select
    Selection.ClearContents
    Range("D8:F38").Select
    Selection.ClearContents
    Range("B2").Select
    Sheets("業務報告書").Select
    Macro1
    End If
    End Sub

    Private Sub CommandButton1_Click()
    ThisWorkbook.Close
    ThisWorkbook.Saved = True
    End Sub

    Sub CloseFile()
    If MsgBox("上書きをしてもいいですか", vbYesNo) = vbYes Then
    ActiveSheet.Protect Password:="1111", DrawingObjects:=True, contents:=True, UserInterfaceOnly:=True
    ThisWorkbook.Save
    Else
    ThisWorkbook.Saved = True
    End If
    ThisWorkbook.Close
    End Sub
  • id:Mook
    回答の修正です。

    シートが複数あり、すべてのシートに Protect が実施されている場合、
    Private Sub Workbook_Open()
      Dim ws As Worksheet
      For Each ws In Worksheets()
        ws.Unprotect Password:="1111"
        ws.Protect Password:="1111", DrawingObjects:=True, contents:=True, UserInterfaceOnly:=True
      Next
    End Sub

    のようにしてください。
  • id:Mook
    関係ないと思いますが(それでも動きましたが)、
      For Each ws In Worksheets()

      For Each ws In Worksheets
    にしてみてください。

    まず、手動でパスワードを全部はずして、VBEから Workbook_Open を実行してみたら、どうなりますか?
    こちらでも動作確認しましたが、問題なく動作しました。

    エラーが出ているのであれば黄色くなったラインと、エラー全文をコメントで記載いただけますか。
  • id:msvista
    >For Each ws In Worksheetsにしてみてください。

    変更いたしました

    >まず、手動でパスワードを全部はずして、
    一旦、全部のパスワードを外し、上書き保存を行いファイルを閉じる。
    ファイルを開くと以下のコメントがポップアップで表示されます。

    実行時エラー'1004':
    入力したパスワードは間違っています。capsLockキーがオフになっていること
    確認し、大文字と小文字が正しく使われていることを確認して下さい。

    終了:デバック:ヘルプ

    とあり、デバックをクリックすると

    ws.Unprotect Password:="1111"

    が黄色くなっています。
  • id:Mook
    そのエラーから推測する限り、やはり設定されているパスワードが違うようです。

    確認のため下記を実行したら、どのようになっているでしょうか。
    Sub unprotectTest()
      Dim ws As Worksheet
      On Error Resume Next
      For Each ws In Worksheets
        ws.Unprotect Password:="1111"
        If Err.Number = 0 Then
          Debug.Print "Unprotect [" & ws.Name & "]" & "is OK"
        Else
          Debug.Print "Unprotect [" & ws.Name & "]" & "is NG"
          MsgBox ws.Name & "の保護の解除に失敗しました。"
          Err.Clear
        End If
      Next
      On Error GoTo 0
    End Sub
    シートの一部が解除できませんか?それとも、すべてのシートができませんか?

  • id:msvista
    ありがとうございました。

    シートを非表示にしていたぶんがあり、
    これのパスワードを解除するのを忘れておりました。

    本当にありがとうございました。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません