[[20130703140541]] 『シートの保護をかけるとVBAが実行時エラーになる』(でめたん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『シートの保護をかけるとVBAが実行時エラーになる』(でめたん)

こちらの掲示板よりコードを拝借して、以下のマクロ内容で「科目リスト」を表示できるようにし、シート1〜10まで同じ仕様で作りました。

他の使用者が数式があるセルを変更できないように「シートの保護」の「ロックされていないセルの選択」にチェックし保護を設定後、
VBA設定セル部分に入力しようとすると「アプリケーション定義またはオブジェクト定義エラー」が出てしまいます。

============
「シートオブジェクト」

Private Sub Worksheet_Change(ByVal target As Range)

    'DicSheetNameは辞書のシート名、
    'DicRangeAddressは辞書の範囲を指定する
    '
    Const DicSheetName = "勘定科目リスト"
    Const DicRangeAddress = "A"

    '※入力セル以外の変更は無視
    If Intersect(target, Range("B10,B12,B14,B16,B18")) Is Nothing Then Exit Sub

    If target.Count > 1 Then
        '選択セルが2つ以上は無効
        MsgBox "複数セル同時変更はサポートしません" & vbLf & "入力を取消し元に戻します"
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If

    Application.EnableEvents = False
    If Not 入力候補表示(DicSheetName, DicRangeAddress, target) Then
        MsgBox "リストにない値の入力は無効です" & vbLf & "入力を取消し元に戻します"
        Application.Undo

    End If

    Application.EnableEvents = True
End Sub

「標準モジュール」
Function 入力候補表示(Sh As String, Rg As String, Tg As Range) As Boolean

    Dim c As Range
    Dim v() As String
    Dim k As Long

    If Len(Tg.Value) = 0 Then   'クリア
        Tg.Validation.Delete
        入力候補表示 = True             'OK
        Exit Function
    End If

    With Sheets(Sh)
        With .Range(Rg & "1", .Range(Rg & .Rows.Count).End(xlUp))
            ReDim v(1 To .Count)
            For Each c In .Cells
                If c.Value Like Tg.Value & "*" Then
                    k = k + 1
                    v(k) = c.Value
                End If
            Next
        End With
    End With

    If k = 0 Then Exit Function     'NG

    If k = 1 Then
        Tg.Validation.Delete
        Tg.Value = v(1)
    Else
        '入力規則のセット
With Tg.Validation '入力規則を設定
            .Delete
            .Add Type:=xlValidateList, Formula1:=Join(v, ",")←この行が黄色なっています
            .ShowError = False
            .InCellDropdown = True
        End With
        Tg.Select
        SendKeys "%{DOWN}"
    End If

    入力候補表示 = True             'OK

 End Function

============

マクロの初心者なので、どこを修正すればエラーが出なくなるのでしょうか?
教えてください。

Excel2010/ WindowsXP


 参考ページ。
http://www.officepro.jp/excelvba/sheet_ope/index2.html
 
定数 UserInterfaceOnly をご覧くだされ。
 
(ROUGE)

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

UserInterfaceOnlyを入れてみましたが、やはりエラーが同じエラーが出てしまいます。

シート保護設定をかけると、入力規則設定のVBAは使えないんでしょうか?

(でめたん)


 >シート保護設定をかけると、入力規則設定のVBAは使えないんでしょうか? 

 残念ながら入力規則の設定は(削除はOKだったと記憶)UserInterfaceOnly:=True の保護下では
 処理不可能みたいね。
 これが必要なら、

 シート保護解除
 必要処理
 シート保護

 こうせざるをえないねぇ。

 (ぶらっと)

ぶらっと さん

 >残念ながら入力規則の設定は(削除はOKだったと記憶)UserInterfaceOnly:=True の保護下では
 >処理不可能みたいね。

やはりできないんですね。

 >シート保護解除
 >必要処理
 >シート保護

のVBAを追加して、エラーが出ずに可能になりました。
ありがとうございました!

(でめたん)


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.