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
お礼
どうも言葉足らずの質問になってしまい、申し訳ありません。個人技術の話ではありませんで、セットオフェンスを展開する時のセオリーについての質問です。つまり、ガードプレイヤーがより下の(エンド寄りのポジションにいる)選手であるフォワードやセンターにまずパスをしなさいと昔よく言われたのですが、その根拠を知りたくて質問したということです。 混乱させてすみません。