2012年6月14日木曜日

Excel スタイル設定一覧を、シートに表示するマクロ

先週に悩まされた、「表示形式を追加できません。」や、「セルの書式が多すぎるため、書式を追加できません」のエラーメッセージでは、いろいろと勉強になりましたので、ここで少しまとめておきます。


Excelのスタイルについて

Excelのスタイルとは、「表示形式」「配置」「フォント」「罫線」「パターン」「保護」等の一連の書式をひとまとめにして名前を付けたものです。 よく使う書式の組み合わせをスタイルとして登録しておくと一度に設定できるため、書式を別々に設定するよりも効率が良くなるというわけです。 実はこの機能、今まで使ったことが無く今回初めて知りました。

Excel2007では組み込みスタイルが増えて、こんなスタイルが登録されているようです。


使用できるスタイルの件数

Excel 2007 では、一意のセル書式を 64,000 使用することができますが、以前のバージョンの Excel では一意のセル書式は最大で 4,000 しか使用することができません。一意のセル書式には、ブック内で適用される特定の書式の組み合わせすべてが含まれます。

「以前のバージョンの Excel でサポートされない Office Excel 2007 の機能」より引用  http://office.microsoft.com/ja-jp/excel-help/HA010077823.aspx


ワークシートをコピーするとスタイルが増える

Excel2000やExcel2003ではセル書式は最大4,000使えるので、一般的な使い方ならばセル書式が4,000もあれば十分かもしれません。しかし、ここに落とし穴がありました。

それはExcel2007で作成されたブックを「Microsoft Office互換機能パック」で変換後、Excel2003を使って編集しようとした時に発生した「ワークシートのコピーでスタイルが増加する」という現象でした。

コピー前は1608件だったスタイル件数が、シートコピー後に3065件に増えました。 この不思議な現象はワークシートのコピーで発生しましましたが、シートからシートへのセル範囲のコピーでは発生しませんでした。 

Microsoftサポートサイトの
「Excel 2007 で、使用されていないスタイルが、あるブックから別のブックへコピーされます。」 http://support.microsoft.com/kb/2553085/ja 
が解決の糸口になるのかもしれませんが、Excel2007を持っていないのでこれは未確認です。

スタイルはブックに登録されるのでブックごとにスタイルの件数が違うようです。 Excel2007で作成されたブックでは、ワークシートのコピーでスタイルが増えるようなので、Excel2007で繰り返しワークシートをコピーして編集するような使い方をしている場合は、気づかないうちにスタイルが増えているのかもしれません。


スタイルが増えすぎるとどうなるのか

Excel2007で作成された、「スタイルが増えすぎたブック」を「Microsoft Office互換機能パック」で変換後に調べてみました。(この時のスタイル件数は3065件)

まっさらなワークシートをひとつだけ残して、他のワークシートをすべて削除した状態で書式設定をすると Excel2000では「表示形式を追加できません。」 が表示されました。 Excel2003では「セルの書式が多すぎるため、書式を追加できません」 が表示されました。

次にユーザースタイルをマクロを使って一括削除すると再び書式設定が出来るようになりました。

このことから、ワークシート内の書式数では無くて、スタイルの登録件数が多い場合に、このようなエラーが発生することがわかりました。(4,000件に満たない場合でも起こるようです。)



追記:2013年4月10日
スタイルが増えすぎて開くことができない場合は、この投稿が役立つかもしれません。

Office 互換機能パックでxlsxファイルが開けない。
Office 互換機能パックでxlsxファイルを開こうとすると「表示形式を追加できません。」や「セルの書式が多すぎるため、書式を追加できません」が表示される。


追記:2016年6月22日
Excelのスタイルに関連する他の投稿




スタイル設定をシートに出力するマクロ

大量のスタイル設定の内容を一覧表形式で確認したかったので、スタイル設定をシートに書き出すマクロを作ってみました。 一覧表に出力したスタイルを見てみると、Excelが自動的に(勝手に)追加したと思われるスタイルが大量にありました。

シートに出力したスタイル
シートに出力したスタイル

このマクロは、Excel2000とExcel2003を使って、WindowsXP SP3で動作確認しました。 マクロを実行すると、アクティブなブックに新しいシートを追加してスタイル一覧を出力します。

出力する書式設定の内容は、

  • スタイルの種類
  • セルにスタイル適用した結果を表示
  • スタイル名
  • 表示形式
  • 配置
  • 縦横位置
  • フォント名とサイズ
  • 罫線 左、右、上、下、右斜め下、右斜め上
  • パターン
  • 保護
  • 数式表示
としました。

組込スタイルとユーザースタイル別に、登録されたスタイル名順に並んでいます。

スタイルダイアログで「スタイルに設定されている書式」にチェックのない項目は適用されないため、書式の登録があっても表示していません。

スタイルの内容が確認できるように、B列のセルにスタイル設定を適用した表示をしています。


スタイル設定をシートに出力する VBAマクロ

'新しいシートにスタイルを出力。
Sub View_Style()
    Dim nCnt As Long
    Dim BltinCnt As Long
    Dim NotBltinCnt As Long
    Dim i As Long
    Dim st As String
    Dim stVal As Long
    Dim cnt As Long
    Dim sTitle As Variant
    Dim sh As Worksheet
    Dim bk As Workbook
    
    Dim kName As Variant
    Dim kXlValue As Variant
    Dim kStr(5) As String
    Dim kNum As Integer
    sTitle = Array("種類", "スタイル表示", "スタイル名", "表示形式", "配置 縦", "配置 横", "フォント名", _
                "サイズ", "罫線", "罫線", "罫線", "罫線", "罫線", "罫線", "パターン", "保護", "数式表示")
    kName = Array("左", "右", "上", "下", "右斜め下", "右斜め上")
    kXlValue = Array(xlLeft, xlRight, xlTop, xlBottom, xlDiagonalDown, xlDiagonalUp)
    
    On Error GoTo ERR_EXIT
    
    Set bk = ActiveWorkbook
    Set sh = bk.Worksheets.Add
    
    NotBltinCnt = 0
    BltinCnt = 0

    'タイトル表示
    sh.Range("a1").Resize(1, 17).Value = sTitle
    
    'スタイル読み出し
    cnt = bk.Styles.Count
    For i = 1 To cnt
        nCnt = i + 1
        
        '種類
        If bk.Styles(i).BuiltIn Then
            '組込みスタイル
            BltinCnt = BltinCnt + 1
            sh.Range("A" & nCnt).Value = "組込"
        Else
            'ユーザースタイル
            NotBltinCnt = NotBltinCnt + 1
            sh.Range("A" & nCnt).Value = "ユーザー"
        End If
        
        'スタイル表示
        sh.Range("B" & nCnt).Value = 1234567890

        'スタイル名
        sh.Range("C" & nCnt).Value = bk.Styles(i).NameLocal

        '表示形式
        If bk.Styles(i).IncludeNumber Then
            st = bk.Styles(i).NumberFormatLocal
        Else
            st = "-"
        End If
        sh.Range("D" & nCnt).Value = st
        
        '配置
        If bk.Styles(i).IncludeAlignment Then
            '縦 xlVAlign
            stVal = bk.Styles(i).VerticalAlignment
            Select Case stVal
            Case xlVAlignTop
                st = "上"
            Case xlVAlignCenter
                st = "中央"
            Case xlVAlignBottom
                st = "下"
            Case xlVAlignJustify
                st = "両端揃え"
            Case xlVAlignDistributed
                st = "均等割り付け"
            Case Else
                st = ""
            End Select
            sh.Range("E" & nCnt).Value = st

            '横 XlHAlign
            stVal = bk.Styles(i).HorizontalAlignment
            Select Case stVal
            Case xlHAlignGeneral
                st = "標準"
            Case xlHAlignLeft
                st = "左"
            Case xlHAlignCenter
                st = "中央"
            Case xlHAlignRight
                st = "右"
            Case xlHAlignFill
                st = "繰り返し"
            Case xlHAlignJustify
                st = "両端揃え"
            Case xlHAlignCenterAcrossSelection
                st = "選択範囲で中央"
            Case xlHAlignDistributed
                st = "均等割り付け"
            Case Else
                st = ""
            End Select
            sh.Range("F" & nCnt).Value = st
        Else
            sh.Range("E" & nCnt).Value = "-"
            sh.Range("F" & nCnt).Value = "-"
        End If
        
        'フォント
        If bk.Styles(i).IncludeFont Then
            'フォント名
            sh.Range("G" & nCnt).Value = bk.Styles(i).Font.Name
            
            'フォントサイズ
            sh.Range("H" & nCnt).Value = bk.Styles(i).Font.Size
        Else
            sh.Range("G" & nCnt).Value = "-"
            sh.Range("H" & nCnt).Value = "-"
        End If
        
        '罫線 XlLineStyle
        If bk.Styles(i).IncludeBorder Then
            For kNum = 0 To 5
                stVal = bk.Styles(i).Borders(kXlValue(kNum)).LineStyle
                If stVal <> xlLineStyleNone Then
                    kStr(kNum) = kName(kNum)
                Else
                    kStr(kNum) = "なし"
                End If
            Next kNum
            With sh.Range("I" & nCnt).Resize(1, 6)
                .Value = kStr
            End With
            
        Else
            With sh.Range("I" & nCnt).Resize(1, 6)
                .Value = "-"
            End With
        End If
        
        'パターン XlPattern
        If bk.Styles(i).IncludePatterns Then
            If bk.Styles(i).Interior.Pattern = xlPatternNone Then
                st = "網かけなし"
            Else
                st = "網かけ"
            End If
        Else
            st = "-"
        End If
        sh.Range("O" & nCnt).Value = st
        
        '保護
        If bk.Styles(i).IncludeProtection Then
            'ロック
            If bk.Styles(i).Locked Then
                st = "ロック"
            Else
                st = ""
            End If
            sh.Range("P" & nCnt).Value = st
            
            '非表示
            If bk.Styles(i).FormulaHidden Then
                st = "表示しない"
            Else
                st = "表示"
            End If
            sh.Range("Q" & nCnt).Value = st
        Else
            sh.Range("P" & nCnt).Value = "-"
            sh.Range("Q" & nCnt).Value = "-"
        End If
    Next i
    
    '並べ替え 種類:降順、 スタイル名:昇順、 先頭行:タイトル
    With sh.Range("A1").Resize(cnt + 1, 17)
        .Sort Key1:=Range("A2"), Order1:=xlDescending, Key2:=Range("C2"), Order2:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False
        .Font.Size = 9
        .Columns.AutoFit
    End With
    
    'スタイル表示セルに、スタイルを適用
    For i = 2 To cnt + 1
        sh.Range("B" & i).Style = sh.Range("C" & i).Value
    Next i
    
ERR_EXIT:
    If Err.Number <> 0 Then
        MsgBox "エラー№:" & Err.Number & " " & Err.Description, , "エラーのため終了します"
    End If
    
    Set sh = Nothing
    Set bk = Nothing
    
    MsgBox "組込スタイル=" & BltinCnt & ", ユーザースタイル=" & NotBltinCnt & vbCr & _
    "スタイル合計=" & BltinCnt + NotBltinCnt, , "スタイル件数"
End Sub


0 件のコメント :