[[20110726164917]]　『ReadOnly → (強制)Save』（新入生）　ページの最後に飛ぶ

『ReadOnly → (強制)Save』（新入生）

 D:\TEST.xls があります。

 こちらは「読み取り専用を推奨する」にチェックが
 入った状態で保存されています。

 この「読み取り専用」を YES で開こうと NO で
 開いていようと

 Sheet1 の A1 セルに 今日の日付 を入力し、
 上書き保存し、
 読み取り専用の状態にする

 というマクロを作るにはどのようにすれば
 良いでしょうか？

 よろしくお願い致します。

 WindowsXP,Excel2003

 ワークブックのモジュールに
 Private Sub Workbook_Open()
 If ActiveWorkbook.ReadOnlyRecommended = True Then
   ActiveWorkbook.ReadOnlyRecommended = False
 End If
 Me.Sheets("Sheet1").Range("A1").Value = Now
 Me.Sheets("Sheet1").Range("A1").NumberFormatLocal = "yyyy/m/d;@"
 ThisWorkbook.Save
 ActiveWorkbook.ReadOnlyRecommended = True
 End Sub
 上記を貼り付けてみて

  早速ご教示頂いたのに、説明不足で本当に
  申し訳ありません。

 「開く時に」ではなく、「既に開いている
  状態で、任意のタイミングで TODAY を
  記録したい」と考えております。

  重ねて恐縮ですが、どうぞよろしくお願い
  致します。

  (新入生)

 対象のブックをbook1.xlsだとすると

 対象ブックを同じフォルダ上に別名で保存する(仮にtmp.xls)
 book1.xlsを削除する
 tmp.xlsのSheet1 の A1 セルに 今日の日付 を設定する
 これをbook1.xlsとして、読取専用を推奨するに設定して保存する
 book1.xlsのブックのアクセス権を読取専用に変更する（ChangeFileAccessメソッド）
 tmp.xlsを削除する

 こんな手順でVBAコードを作成してみては？

 ichinose

  ichinose さん

  アドバイスありがとうございました。
  都度“作り直す”ということでしょうか。思いつきも
  しませんでした。それで対応することにします。

  もうひとつご教示頂けるでしょうか。
  最初にアドバイス頂いた

  If ActiveWorkbook.ReadOnlyRecommended = True Then ActiveWorkbook.ReadOnlyRecommended = False

  との一文を入れて試してみたのですが、 これですと
 「読み取り専用で開きますか？」と聞かれてしまいます。
  このメッセージを出さずに NO で開く方法があったら
  お教え下さい。

  よろしくお願い致します。

  (新入生)

 すみません。

 色々試していて間違えました。

 > 読み取り専用で開きますか？」と聞かれてしま
 うのは、

 If ActiveWorkbook.ReadOnly Then ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, Notify:=True

 でした。

 どうぞよろしくお願い致します。

 (新入生)

 読み取り専用を推奨するで作成されたブックは、

 ChangeFileAccess Mode:=xlReadWrite

 で　読み取り専用にしていた間に変更された部分がないことを確認するために、ファイルが改めて読み込まれます。
 よって、読み取り専用で開きますか？　というメッセージが表示されるのですが・・・。

 前回投稿した手順で行う限り、
 ChangeFileAccess Mode:=xlReadWrite
 このメソッド（書き込み可能にする）は、不要ですがねえ・・・。

 考えているコードを全部掲載してください。

 ichinose

 ichinose さん

 ありがとうございます。

 > 考えているコードを全部掲載して ～

 －－－－－－－－－－－－－－－－－－－－－－

 Sub TEST()

    If ActiveWorkbook.ReadOnly Then ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, Notify:=True

    Sheets("Sheet1").Range("A1").Value = Date

    ActiveWorkbook.Save

    ActiveWorkbook.ReadOnlyRecommended = True

 End Sub

 －－－－－－－－－－－－－－－－－－－－－－

 上記でできれば良いな、とも考えておりますが、
 前述の通り、一行目で
 >>「読み取り専用で開きますか？」と聞かれてしまいます。
 >> このメッセージを出さずに NO で開く方法があったら
 ご教示頂けますようお願い致します。

 (新入生)

 >変更された部分がないことを確認する
 自分で記述していて今更ながら気が付きました。
 読取専用で開いた時は、それまでの変更は、保存したくない
 書き込み可のときは、それまでも変更も保存するでしたね！！

 そうなると、手順が少し違いますねえ
 が、Mode:=xlReadWriteこれは、必要ないかなあ・・・。
 標準モジュールに

 '==================================================================
 Sub test()
    Dim bk As Workbook
    Dim ro As Boolean
    Dim bnm As String
    bnm = ThisWorkbook.FullName
    ro = ThisWorkbook.ReadOnly
    If ro Then
       Application.DisplayAlerts = False
       ThisWorkbook.SaveAs ThisWorkbook.Path & "\tmp.xls"
       Application.DisplayAlerts = True
       Set bk = Workbooks.Open(Filename:=bnm, IgnoreReadOnlyRecommended:=True)
    Else
       Set bk = ThisWorkbook
    End If
    With bk.Sheets("sheet1").Range("a1")
       .Value = Now
       .NumberFormatLocal = "yyyy/m/d;@"
    End With
    bk.Save
    bk.ChangeFileAccess Mode:=xlReadOnly
    If ro Then
       ThisWorkbook.Close False
    End If
 End Sub
 Sub auto_close()
   On Error Resume Next
   Kill ThisWorkbook.Path & "\tmp.xls"
   On Error GoTo 0
 End Sub

 コード中のテンポラリーファイルtmp.xlsは、実際にはもう少しユニークな名前が
 よいですねえ！！

 これで試してみてください。
 因みにReadOnlyRecommendedは、値の取得だけで設定はできませんよ！！

 ichinose

 ichinose さん

 何度もありがとうございます。

 > 因みにReadOnlyRecommendedは、値の取得だけで設定はできませんよ！！

 すみません(何度目？)。最後の一文は

 >> ActiveWorkbook.ReadOnlyRecommended = True

 ではなく

 ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly

 でした。結局

 >>> このメッセージを出さずに NO で開く方法

 はない、ということですね。考えてみたら
 開き直す ＝ 一度マクロもチャラになる(死んじゃう)
 ってことでしょうから、当たり前のことなのでしょうね。
 お恥ずかしい限りです。

 ご提示頂いた、一旦“外に逃げて”再度開き直し → 加工 →
 保存 → ReadOnly 再設定 → という方法で解決致しました。

 tmp.xls (※)は以降残り、それを使いまわす、ということで
 全く問題はないのですが、ご提示頂いた Sub auto_close を
 うまく使うと都度 Kill できるのでしょうか？

 ※ > 実際にはもう少しユニークな名前がよい ～

 ありがとうございます。
 オリジナルの Filename & (複) とかにしてみます。

 (新入生)

 >提示頂いた Sub auto_close を
 >うまく使うと都度 Kill できるのでしょうか？

 こんな方法もありますねえ

 '====================================================
 Option Explicit
 Const tmp = "tmp.xls"
 Sub test()
    Dim bk As Workbook
    Dim ro As Boolean
    Dim bnm As String
    bnm = ThisWorkbook.FullName
    ro = ThisWorkbook.ReadOnly
    If ro Then
       Application.DisplayAlerts = False
       ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & tmp
       Application.DisplayAlerts = True
       Set bk = Workbooks.Open(Filename:=bnm, IgnoreReadOnlyRecommended:=True)
    Else
       Set bk = ThisWorkbook
    End If
    With bk.Sheets("sheet1").Range("a1")
       .Value = Now
       .NumberFormatLocal = "yyyy/m/d;@"
    End With
    bk.Save
    bk.ChangeFileAccess Mode:=xlReadOnly
    If ro Then
       Application.OnTime Now(), bk.Name & "!auto_close"
       ThisWorkbook.Close False
    End If
 End Sub
 Sub auto_close()
    On Error Resume Next
    Kill ThisWorkbook.Path & "\" & tmp
    On Error GoTo 0
 End Sub

 ichinose

  ichinose さん

  本当にありがとうございました。お陰様で
  解決致しました。

 「知識」はもちろんですが、それを使いこなす
 「思考法 / 知恵」の面でも大変勉強させて
  頂きました。

  これからもご指導頂けますよう、どうぞ宜しく
  お願い申し上げます。

  (新入生)

コメント返信：

[ 一覧(最新更新順) ]

[[20110726164917]] 『ReadOnly → (強制)Save』（新入生） ページの最後に飛ぶ

[[20110726164917]]　『ReadOnly → (強制)Save』（新入生）　ページの最後に飛ぶ