保護シートでの オートフィルタ、グループ化の実行 と 共有の両立

Private Sub Workbook_Open()
    Dim Users　　’UserList
    If ActiveWorkbook.MultiUserEditing Then
        Users = ActiveWorkbook.UserStatus
        If UBound(Users) = 1 Then
            MsgBox "他に開いているユーザーはいません"
        Else
            MsgBox "あなた以外の誰かがブックを開いています"
            Exit Sub
        End If
        MsgBox "共有を解除します。"
        Application.DisplayAlerts = False
        ActiveWorkbook.UnprotectSharing
        ActiveWorkbook.ExclusiveAccess
        Application.DisplayAlerts = True
    Else
        MsgBox "共有ブックとして開いていません"
    End If
        Sheet1.EnableOutlining = True
        Sheet1.EnableAutoFilter = True
        Sheet1.Protect Userinterfaceonly:=True
   　　 MsgBox "シートの保護設定を行いました"

        MsgBox "共有設定します。"
        Application.DisplayAlerts = False
        ActiveWorkbook.ProtectSharing
 '      ActiveWorkbook.ExclusiveAccess
        Application.DisplayAlerts = True

 
End Sub

入力セル情報、Shapeの文字情報の取得

'所定のセル範囲の中から　入力のあるセルのアドレスと内容（値と式）を列挙する
'範囲は　O_Area
'書き出し位置は　O_DicTOP に　レンジオブジェクトとして登録されているとする。
Sub Test1()
    Dim sText As String
    Dim sFormula As String
    Dim i As Long
    i = 0
    Dim myCell As Range
    For Each myCell In O_Area
        sText = myCell.Text
        sFormula = myCell.Formula
        If Trim(sText) <> "" Then
            i = i + 1
            O_DicTop(i, 1).Value = myCell.Address(external:=True)
            O_DicTop(i, 2).Value = "　"
            O_DicTop(i, 3).Value = sText
            If sText <> sFormula Then
                O_DicTop(i, 4).Value = "'" + sFormula
            Else
                O_DicTop(i, 4).Value = ""
            End If
        End If
    Next
End Sub

'アクティブなシート状にあるShapeオブジェクトの名前と内容,タイプを列挙する
'書き出し位置は　O_DicTOP に　レンジオブジェクトとして登録されているとする。
Sub test2()
    Dim myShape As Shape
    Dim sSheet As String
    sSheet = ActiveSheet.Name
    i = 0
    For Each myShape In ActiveSheet.Shapes
        sText = myShape.TextFrame.Characters.Text
        i = i + 1
        O_DicTop(i, 1).Value = "obj:" + sSheet + "!" + myShape.Name
        O_DicTop(i, 2).Value = "Set CellName"
        O_DicTop(i, 3).Value = sText
        O_DicTop(i, 4).Value = myShape.Type
    Next
End Sub

不明なリンクの削除方法

不明なリンクの削除方法

課題　ブックに不明なリンクが残り削除できないことがある。

対策概要　リンクの原因となる以下の状態を解除する。

1. 他のシート、ブックへのセル参照がセル数式に含まれている。
2. 条件付き書式で　セル参照をしている。
3. データ入力規則で　リストがセル範囲となっている。
4. 図形、ボタン、テキストボックスなどのテキストがセル参照設定となっている。

解説　　サンプルのVBAはシート全体を処理対象に、参照元を問わず、すべての参照、数式を削除するもの。　

1. 参照式が不要ならば、対象範囲をコピーして文字として自分自身に貼りなおす。
   • 　　Cells.Copy  
         Cells.PasteSpecial Paste:=xlPasteValues
2. 対象範囲を選択し　条件付き書式をクリアする。
   •     Cells.FormatConditions.Delete
3. 対象範囲を選択し　データ入力規則を削除する。
   •     Cells.Validation.Delete
4. 対象範囲のフォームコントロールのボタンオブジェクト、テキストボックスオブジェクトの参照式を削除する。
   参照式を削除しても表示されている文字は文字データとして残る。
   •     Dim myShape As Object    
     'アクティブシート上の全ボタンに設定された参照式を削除する。
         For Each myShape In ActiveSheet.Buttons
             myShape.Formula = ""
         Nexｔ
     'アクティブシート上の全テキストボックスに設定された参照式を削除する。
         For Each myShape In ActiveSheet.TextBoxes
             myShape.Formula = ""
         Next