| |
▼pio さん：
>りんさん、ありがとうございます。
>
>私の理解が遅く、再度の説明をして頂き
>すいませんでした。
>
>実際にマクロを組んでやってみようと思います。
>ほんとにありがとうございました。
あれから調べてみたところ、フォント以外のダイアログはシートに保護がかかっていると表示不可でした。
とりあえず、フォントだけでも。
↓以下を全部Thisworkbookに記述=====
Private Function Dtype(tag As Integer) As Integer
Dim tf As Boolean, c As Range, result As Integer
result = 0
If ActiveWindow.SelectedSheets.Count > 1 Then
tf = False: result = -88 '複数シート選択
Else
tf = True
If ActiveSheet.ProtectContents = True Then
If TypeName(Selection) = "Range" Then
For Each c In Selection
tf = tf And (Not c.Locked = True)
Next
Else
tf = False
End If
End If
End If
'
If result >= 0 Then
If tf = False Then
result = -77 '保護セルあり
Else
result = xlDialogFontProperties
End If
End If
'結果
Dtype = result
End Function
Private Sub Dshow()
Dim II%
On Error Resume Next
II% = Application.CommandBars.ActionControl.tag
On Error GoTo 0
'
JJ% = Dtype(II%)
'
If JJ% > 0 Then
Application.Dialogs(JJ%).Show
Else
Select Case JJ%
Case -77: AAA$ = "選択範囲に保護セルあり"
Case -88: AAA$ = "作業グループは非対応"
Case -99: AAA$ = "インデックスが違います（何故？）"
Case Else
AAA$ = "その他エラー？"
End Select
'
MsgBox AAA$, vbCritical, ActiveWorkbook.Name
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cb As CommandBar
For Each cb In Application.CommandBars
If cb.Name = "Cell" Then
CBEdit cb.Index, False
End If
Next
End Sub
Private Sub Workbook_Open()
Dim cb As CommandBar
For Each cb In Application.CommandBars
If cb.Name = "Cell" Then
CBEdit cb.Index, True
End If
Next
End Sub
Private Sub CBEdit(II%, flg As Boolean)
Dim cbp As CommandBarPopup, cbb As CommandBarButton, JJ%
With Application.CommandBars(II%)
.Reset
'
If flg = True Then
.Controls(1).BeginGroup = True
'追加開始
Set cbb = .Controls.Add(Type:=msoControlButton, before:=1)
With cbb
.Caption = "フォント"
.OnAction = ThisWorkbook.Name & "!Thisworkbook.Dshow"
End With
End If
End With
End Sub
↑ここまで========
UserInterFaceOnlyをTrueにしておくとマクロからセルに関する各種の変更が可能なので、色を塗ったり罫線を引きたいときは、そこで直接指定したらよいと思います。
セルをオレンジ色に塗るコマンドを右クリック（セル）メニューに登録
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=5027;id=excel
|
|
りん
- 05/9/14(水) 20:22 -
