| |
ＧＨＱ さん、こんばんわ。
>手作業の場合、メニューのツール→保護→範囲の編集を許可を開き、
>=$BG$22,$BF$24:$BI$26,$BK$24:$BM$26,･････
>てな具合に、複数の範囲をコンマで区切って記述しますが、
>編集許可範囲の一タイトルあたり、２２組が限度のようです。
２２組というより、グラフ等と同じく文字数の制限な気もします。
Sub Test()
Dim II As Integer
Dim r1 As Range, r2 As Range, resp As Integer
'
With Application.ActiveSheet
.Unprotect
If .Protection.AllowEditRanges.Count = 1 Then
'設定が一つだけあったらセット（ほかは無視）
Set r2 = .Protection.AllowEditRanges.Item(1).Range
resp = vbYes
Else
MsgBox .Protection.AllowEditRanges.Count
resp = MsgBox("コピーしますか？", vbYesNo, "許可設定が０または複数でした")
End If
'
If resp = vbYes Then
For II = 1 To 100
Set r1 = .Cells((II - 1) * 17 + 27, 2)
'
.Range("B10:F26").Copy Destination:=r1
If Not r2 Is Nothing Then
'編集許可をセルを追加
.Protection.AllowEditRanges.Add _
Title:="Add_" & Format(II, "0000"), _
Range:=r2.Offset(17 * II, 0)
End If
Next
'１つめは範囲が拡張されるので戻す
If Not r2 Is Nothing Then
Set .Protection.AllowEditRanges.Item(1).Range = r2
End If
End If
End With
End Sub
こんな感じです。
コピーした後で、参照位置をOFFSETでずらして設定していきます。
'
パスワードを設定しないなら、書式で保護をしないほうが簡単ですね。
おまけ
Sub test2()
'一つ目の条件以外を削除
Dim II As Integer, IMax As Integer
With Application.ActiveSheet
.Unprotect
IMax = .Protection.AllowEditRanges.Count
For II = IMax To 2 Step -1
.Protection.AllowEditRanges.Item(II).Delete
Next
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 07/3/1(木) 14:30 -
