VBA データセットした後にその一部をLOCK

質問

こんばんは。
お世話になります。

エクセルVBAにてアクセスからデータを取得し、その一部をロックしたいです。
(取得方法には色々あるかと思います。
経験が浅いためどう表現すれば適切か自信がありませんが
「ADOコネクションオブジェクトとADOレコードセットオブジェクトにて実施しています。」)

【VBAの仕様の説明】
「読込」ボタンを押すと、B12～AA1000のエリアのデータを一掃して、
そこに条件によりレコード数が変わりますが、アクセスのデータをセットしています。
その後、これらの出力されたレコードについてエクセル上にて値を書き換えたのちに
「更新」ボタンを押すと、アクセスに更新に行くというものです。

このときB,C,D,E列については、更新処理時に重要なものであり、F列以降と異なり
書き換えてはいけないものです。

【実現したいこと】
このエクセルを開いてから閉じるまでの間、いつでもB12～E1000は手入力不可にしたいです。
ただし、エクセルを開いていきなりロックをしてしまうと、「読込」を押したときに
アクセスのデータを出力するときにエラーになってしまいますので
読込ボタンを押した後はB12～E1000のロックを外したいです。
これが難しいようであれば、エクセルを開いてから「読込」を押すまでの間は
ロックをかけなくてもよいです。

ある程度ググったので
シートを保護する　＆　特定のセルのLOCKをfalseにする　を適切なタイミングで
実施するのだとは理解していますが、実装しようとすると
「RangeクラスのLockedプロパティを設定できません」というエラーが出てしまって
詰まってしまっています。

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

↓↓↓↓ソースです。↓↓↓↓
Private adoCn As Object 'ADOコネクションオブジェクト
Private adoRs As Object 'ADOレコードセットオブジェクト
Private strSQL As String 'SQL文
Private Const DBpath As String = "C:\zaiko.accdb" '接続するファイル（2007～）のフルパス

'---------ファイルが開けない場合のエラーを追加
Private file_error As String
'---------

Sub DBconnect(flg As Boolean) 'DB接続プロシージャ

'---------ファイルが開けない場合のエラーを追加
On Error GoTo Err_Handler 'エラーが起きたら"Err_Handler"へ
file_error = 0 'エラーが起きない正常な間はエラーをオフにする。
'---------

Set adoCn = CreateObject("ADODB.Connection") 'ADOコネクションオブジェクトを作成

If flg = True Then Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成
'adoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBpath & ";" 'Accessファイル（～2003）を開く
adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & ";" 'Accessファイル（2007～）を開く

'---------ファイルが開けない場合のエラーを追加
Exit Sub '正常ならここで終了
Err_Handler: 'エラーが起きたらここへ飛ぶ
MsgBox "「C:\」フォルダの下にエクセルとアクセスファイルを置いてください。"
file_error = 1
'---------

End Sub

Sub DBcut_off(flg As Boolean) 'DB切断プロシージャ

If flg = True Then adoRs.Close 'レコードセットのクローズ
adoCn.Close 'コネクションのクローズ
Set adoRs = Nothing 'オブジェクトの破棄
Set adoCn = Nothing

End Sub

Sub DBread() '読み込み
Dim shouhinbangou As String, dy As String, txt As String

Call DBconnect(True) 'DB接続

If file_error = 1 Then
file_eroor = 0 '初期化してから
Exit Sub '処理終了
End If

With UserForm1
.show 'ユーザーフォーム表示

If .TextBox1 = "" Then '商品番号欄が空欄の場合
shouhinbangou = ""
Else '商品番号欄が記入済
shouhinbangou = "WHERE item_no LIKE '%" & .TextBox1 & "%' " '～を含む
End If
End With

strSQL = _
"SELECT * " & _
"FROM zaiko_table " & _
shouhinbangou

adoRs.Open strSQL, adoCn 'SQLを実行して対象をRecordSetへ

Range("B12:Z1000").ClearContents '前のデータクリア
Range("B12:Z1000").Font.ColorIndex = xlAutomatic 'フォント色を初期化
Range("B12:AA1000").Borders.LineStyle = xlLineStyleNone

Application.EnableEvents = False 'イベントオフ(ワークシートチェンジが反応しないように)
i = 12 'スタート行
Do Until adoRs.EOF 'レコードセットが終了するまで処理を繰り返す
Cells(i, 2) = adoRs!ID
Cells(i, 3) = adoRs!item_no
Cells(i, 4) = adoRs!color_no
Cells(i, 5) = adoRs!item_name
Cells(i, 6) = adoRs!～～～
～中略～
Cells(i, 26) = adoRs!～～～
i = i + 1 '行をカウントアップする
adoRs.MoveNext '次のレコードに移動する
Loop

'下から数える
With Range("B12")
.Resize(Cells(Rows.Count, .Column).End(xlUp).Row - .Row + 1, 26).Borders.LineStyle = xlContinuous
End With

Application.EnableEvents = True 'イベントオン

Call DBcut_off(True) 'DB切断

End Sub

回答No.3

puddingeater · ベストアンサー

> 赤字化されているセルの値をアクセスに更新する仕様なのですが、
> この赤字化するモジュール内でエラーになってしまいます。

試してみました。
保護を有効にするとき、デフォルトでは書式の変更が許可されていないためと思われます。
ActiveSheet.Protect AllowFormattingCells:=True
のように許可してやればエラーが消えました。
ほかにも色々オプションがありますので、Worksheet.Protect のヘルプを見て仕様に合うよう調整してください。

参考URL：

http://msdn.microsoft.com/ja-jp/library/ff840611.aspx

お礼

ありがとうございます！
出来ました。
cellsとrangeの影響等は無関係でしたね。
調べる方向性がまったく違っていてうまく目的に到達できませんでした。

大変助かりました、ありがとうございます。

参考URLも見ました。
役に立つサイトをありがとうございます。

回答No.2

nicotinism

#1 です。
ごめんなさい。
当方Excel2010ですが、VBAでシート保護を行うと
パスワードの設定はしていないにもかかわらず、
UnProtect しようとすると、パスワードを要求される事態に。。。
？？？？？？？？？？？？？？？？？？？？？？？？？？？？？

そちらのエラーの原因はWorksheet.Protect メソッドのパラメータが適切でないため？
のような気がしますけれども、
申し訳ありません、こちらを閉じて、再度質問を立て直して
あらまほしき先達の方のご登場をおまちください。
すみません。

お礼

おはようございます。

ご連絡ありがとうございます。

nicotinismさまの状況はまた私のものとは
違うようですね。。

この質問は閉じないこととしようと思います。
実現したいことができていないことと
nicotinismさまとのやりとりから私の最新の
状況がお伝えできるかと思うためです。

どなたか、ご回答よろしくお願いいたします。

nicotinismさま、改めて迅速なご回答、
そして最新の私の状況にもご対応を試みて下さり
ありがとうございました。感謝しています。

回答No.1

nicotinism

>実装しようとすると
>「RangeクラスのLockedプロパティを設定できません」というエラーが出てしまって
問題を切り分けるために別の適当なファイルで
ロック・アンロックのSub モジュール２個だけをつくって試されては？

RangeクラスのLockedプロパティを設定できません
でGoogleとシート保護・セルのロックの順番が違うとダメとか
連結セルが・・
とかヒットしますけど。。

お礼

ありがとうございます。

subモジュール2個で試してみました。

そのテストはうまく行ったので
ロック処理とアンロック処理の記述を
上記ソースの先頭と末尾にセットしました。

先頭
ActiveSheet.Unprotect '//シート保護を解除

末尾
Range("F12:Z1000").Locked = False '//在庫数部分のみアンロック
Range("AB12:AB1000").Locked = False '//備考部分のみアンロック
ActiveSheet.Protect '//シート保護

ほぼ成功したのですが、上記adoRsでデータセットしている部分のセルの数値を変更すると、そのセルを赤字化し、
赤字化されているセルの値をアクセスに更新する仕様なのですが、この赤字化するモジュール内でエラーになってしまいます。

エラー箇所は以下で
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long, c As Long

c = Target.Column '変更されたセルの列
r = Target.Row '変更されたセルの行

If c < 6 Or 26 < c Or r < 12 Or 100 < r Then Exit Sub '範囲外なら終了

Cells(r, c).Font.ColorIndex = 3 'セルを赤文字に【ココ】

End Sub

エラー内容は以下です。
「アプリケーション定義またはオブジェクト定義のエラーです。」

RangeとCellsはよく一緒に見かけるのですが、
今回セルのロックにRangeを使っていることにより
この赤字化のCellsの部分に影響を及ぼしているのではないかと推測しています。

状況と解決策がお分かりでしたらよろしくお願いいたします。