ExcelマクロVBAサンプル集 | 条件付き書式で変更された書式を取得する | ExcelマクロVBAの実用サンプル、エクセルVBA集と解説



最終更新日:2018-02-16

条件付き書式で変更された書式を取得する


条件付き書式が設定されている場合、

当然ですが見た目は、本来そのセルに設定されている書式ではなく、

条件付き書式の条件によって設定されている書式になります。

VBAで、この条件付き書式によって設定された書式を取得します。


これが取得できるようになったのは、Excel2010からですので、
このページで紹介するVBAコードはExcel2010以降でのみ有効なものです。


実際の画像



このブックでは、テーマも配色も変更しています。
また、別シートを参照している条件付き書式も設定してあります。

このシートをコピーして新規ブックにすると、



新規ブックなので、テーマや配色は標準で作成されます。

特に目立つので、直ぐに気が付くのが色の変化です。
変化がない部分は、基本色やその他の色(RGB指定)で設定している部分になります。

画像ではわかりづらいですが、コジックがPゴシックにも変わってしまっています。

右半分は、いろいろな条件付き書式を設定していますが、
アイコンセットはアイコンなので、さすがに変化していません。


そもそも、条件付き書式によって設定された書式を取得する必要があるのかという疑問があります。

このようなシーンを想定してみました。

想定シーン

何らかの資料(提出資料、プレゼン資料)を作ることになりました。
資料作成の素材集めとして、作成済のExcelを30ファイル集めました。
各ブックには、複数シートが入っているが、必要なシートはその中の1シートか2シート程度。

資料作成に素材として何を使うかも含めて検討しているが、
毎回、Excelブックを開いて目当てのシートを見つけていたのでは無駄が多いので、
必要なシートだけを集めたブックを新たに作成することにしました。


想定シーンの作業での問題点と解決方法

想定シーンの作業での問題点は、
シートをコピペで他のブックに移したときの問題点になります。

問題点
1.シート間の数式がある場合、後でリンク切れを起こす。

2.使用しているテーマが違う場合、色・フォントが変更されてしまう。

3.条件付き書式で、他のシートを参照しているとリンク切れとなる。

解決方法
1.値貼り付けをすれば良いです。
  これだけなら手作業でも問題ありません。

2.配色のカラーを固定カラーに再設定
  配色を使用したカラー設定を固定カラーに再設定
  ここでは、グラフの色も変更しています。

3.今までこれが解決できませんでした。
  Excel2010で、条件付き書式によって設定された書式を取得することができるようになっています。
  今回のメインテーマとなります。


条件付き書式によって設定された書式の取得方法

Rangeオブジェクトのプロパティに、Excel2010で追加された、
DisplayFormatプロパティ
これを使う事で、条件付き書式で表示された書式を取得できるようになっています。

DisplayFormatプロパティは、DisplayFormatオブジェクトを取得します。
DisplayFormatオブジェクトの各種プロパティを参照することで、
表示されている書式を取得することが出来ます。

DisplayFormatオブジェクトのプロパティ
名前 説明
AddIndent 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトについて、セル内の文字列の配置で縦または横位置を均等に割り付けるときに、文字列を自動的にインデントするかどうかを示す値を返します。値の取得のみ可能です。
Application オブジェクト修飾子を指定せずに使用した場合、Microsoft Excel アプリケーションを表す Application オブジェクトを返します。オブジェクト修飾子を指定した場合、指定したオブジェクトを作成した Application オブジェクトを返します。値の取得のみ可能です。
Borders 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトの境界線を表す Borders オブジェクトを返します。値の取得のみ可能です。
Characters 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトのテキスト内の文字範囲を表す Characters オブジェクトを返します。値の取得のみ可能です。
Creator 現在のオブジェクトが作成されたアプリケーションを示す 32 ビットの整数を取得します。値の取得のみ可能です。長整数型 (Long) の値を使用します。
Font 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトのフォントを表す Font オブジェクトを返します。値の取得のみ可能です。
FormulaHidden 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトについて、ワークシートが保護されているときに数式を非表示にするかどうかを示す値を返します。値の取得のみ可能です。
HorizontalAlignment 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトの水平方向の配置を表す値を返します。値の取得のみ可能です。
IndentLevel 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトのインデント レベルを表す値を返します。値の取得のみ可能です。
Interior 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトの内部を表す Interior オブジェクトを返します。値の取得のみ可能です。
Locked 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトがロックされているかどうかを示す値を返します。値の取得のみ可能です。
MergeCells 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトに、結合されたセルが含まれているかどうかを示す値を返します。値の取得のみ可能です。
NumberFormat 現在のユーザー インターフェイスに表示されるている、関連付けられた Range オブジェクトの表示形式を表す値を返します。値の取得のみ可能です。
これが正しく取得できませんでした。
NumberFormatLocal 現在のユーザー インターフェイスに表示されるている、関連付けられた Range オブジェクトの表示形式を、ユーザーの言語の文字列で表す値を返します。値の取得のみ可能です。
Orientation 現在のユーザー インターフェイスに表示されるている、関連付けられた Range オブジェクトの文字列の向きを表す値を返します。値の取得のみ可能です。
Parent 指定されたオブジェクトの親オブジェクトを取得します。値の取得のみ可能です。
ReadingOrder 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトの読み取り順序を返します。値の取得のみ可能です。
ShrinkToFit 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトについて、使用可能な列幅に収まるように自動的に文字列を縮小するかどうかを示す値を返します。値の取得のみ可能です。
Style 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトのスタイルを表す、Style オブジェクトを含む値を返します。
VerticalAlignment 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトの垂直方向の配置を表す値を返します。値の取得のみ可能です。
WrapText 現在のユーザー インターフェイスに表示されている、関連付けられた Range オブジェクトについて、文字列を折り返すかどうかを示す値を返します。値の取得のみ可能です。


以下で、シートコピーの問題点を解決するためのVBAコードを掲載します。

まずは、実装する機能と実装しない機能について

実装する機能と実装しない機能

実装する機能
・指定シートをコピーし新規シートを作成

・シート全体を値貼り付け

・条件付き書式で表示されている書式を通常書式として設定

・条件付き書式を削除

・フォント、塗りつぶし、罫線の色を固定色に変更

・新規作成シートを新規ブックへ移動


実装しない機能
・グラフおよび図形の色については対応していません
 配色を使用したカラー設定を固定カラーに再設定
 こちらを見ていただければ理解していただけると思いますが、
 VBAコードが非常に長くなりますし、全てのグラフに対応するのはとても大変です。
 必要な場合は、上のページを参考にして、下のサンプルに組み込んでみて下さい。

・塗りつぶしの効果とパターンは対応しない
 通常書式、条件付き書式ともに対応しません。
 VBAが面倒な割に、実際に使っている人は少ないと思うので。

・条件付き書式の表示形式は取得できない
 これはExcelのバグなのか、単なる実装漏れなのか・・・
 でも、下のサンプルでは、別の方法で無理矢理対応しています。


シートコピーの問題点を解決して、新規ブックのシートに切り離すVBA

Option Explicit

Public Function CopySheet(ByVal ws As Worksheet) As Workbook
  Dim wsNew As Worksheet
  Dim wsW As Worksheet
  Dim myRange As Range
  Dim fObj As Object
  Dim fRange As Range
  Dim aryDiagona As Variant
  Dim sFormat As String
  Dim i As Long
  
  '事前設定
  aryDiagona = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlInsideHorizontal, xlInsideVertical)
  
  '指定シートをコピーし新規シートを作成
  ws.Copy After:=ws
  Set wsNew = ActiveSheet
  Set wsW = Worksheets.Add '表示形式の確認で使うワークシート
  
  'シート全体を値貼り付け
  'Valueの代入ではエラーになる場合があるので普通に貼り付け
  wsNew.Cells.Copy
  wsNew.Cells.PasteSpecial Paste:=xlPasteValues
  
  '条件付き書式で表示されている書式を通常書式として設定
  '条件付き書式を使っていない場合はエラーとなる
  On Error Resume Next
  Set fRange = wsNew.Cells.SpecialCells(xlCellTypeAllFormatConditions)
  If Err Then
    Err.Clear
  Else
    On Error GoTo 0
    For Each myRange In fRange
      With myRange.DisplayFormat
        'フォント
        myRange.Font.Color = .Font.Color
        myRange.Font.Bold = .Font.Bold
        myRange.Font.Italic = .Font.Italic
        myRange.Font.Strikethrough = .Font.Strikethrough
        '塗りつぶし
        myRange.Interior.Color = .Interior.Color
        '罫線
        For i = LBound(aryDiagona) To UBound(aryDiagona)
          If .Borders(aryDiagona(i)).LineStyle <> XlLineStyle.xlLineStyleNone Then
            myRange.Borders(aryDiagona(i)).LineStyle = .Borders(aryDiagona(i)).LineStyle
            myRange.Borders(aryDiagona(i)).Weight = .Borders(aryDiagona(i)).Weight
            myRange.Borders(aryDiagona(i)).Color = .Borders(aryDiagona(i)).Color
          End If
        Next
        '表示形式、これは取得できないようです
        myRange.NumberFormatLocal = .NumberFormatLocal
        'そこで条件付き書式を順に確認
        wsW.Range("A1") = myRange
        wsW.Range("A1").NumberFormatLocal = myRange.NumberFormatLocal
        If myRange.Text <> wsW.Range("A1").Text Then
          For i = myRange.FormatConditions.Count To 1 Step -1
            Set fObj = myRange.FormatConditions(i)
            If TypeName(fObj) = "FormatCondition" And _
              Not IsEmpty(fObj.NumberFormat) Then
              wsW.Range("A1").NumberFormatLocal = CStr(fObj.NumberFormat)
              If myRange.Text = wsW.Range("A1").Text Then
                myRange.NumberFormatLocal = fObj.NumberFormat
              End If
            End If
          Next
        End If
      End With
    Next
  End If
  On Error GoTo 0
  
  '条件付き書式を削除
  For i = wsNew.Cells.FormatConditions.Count To 1 Step -1
    Set fObj = wsNew.Cells.FormatConditions(i)
    Select Case fObj.Type
      Case xlIconSets 'アイコンセット
      Case xlDatabar 'データバーは条件付き書式を変更
        Stop
        fObj.BarBorder.Color.Color = fObj.BarBorder.Color.Color
        fObj.BarColor.Color = fObj.BarColor.Color
      Case Else
        wsNew.Cells.FormatConditions(i).Delete
    End Select
  Next
  
  'フォント、塗りつぶし、罫線の色を固定色に変更
  For Each myRange In wsNew.UsedRange
    'フォント
    myRange.Font.ThemeFont = xlThemeFontNone
    myRange.Font.Name = myRange.Font.Name
    If myRange.Font.ColorIndex <> xlColorIndexNone Then
      myRange.Font.Color = myRange.Font.Color
    End If
    '塗りつぶし
    If myRange.Interior.ColorIndex <> xlColorIndexNone Then
      myRange.Interior.Color = myRange.Interior.Color
    End If
    '罫線
    For i = LBound(aryDiagona) To UBound(aryDiagona)
      If myRange.Borders(aryDiagona(i)).ColorIndex <> xlColorIndexNone Then
        myRange.Borders(aryDiagona(i)).Color = myRange.Borders(aryDiagona(i)).Color
      End If
    Next
  Next
  '元のシートを選択
  ws.Select
  
  '新規作成シートを新規ブックへ移動
  wsNew.Move
  Set CopySheet = ActiveWorkbook
  '表示形式の確認で使ったワークシートの削除
  Application.DisplayAlerts = False
  wsW.Delete
  Application.DisplayAlerts = True
End Function

Functionプロシージャーになります。
Function CopySheet
戻り値は、、コピーで作った新規ブックです。

詳しく解説出来ませんので、
VBA内のコメントを参考にしてVBAを読んでください。

注意点
実装しない機能として、
「条件付き書式の表示形式は取得できない」、と書きましたが。
何度か確認しましたが、
DisplayFormatの表示形式のプロパティ
.NumberFormat
.NumberFormatLocal
どちらも正しく取得できないようです。

そこで、上のVBAサンプルでは、
実際に表示されているTextを、
条件付き書式で設定している表示形式に照らして、一致していればその表示形式を設定するようにしています。
この部分は、結構きわどい処理となっていますので、書式によっては有効とならない場合もあるかもしれません。


使い方

アクティブシートを新規ブックにコピーします。

Sub sample()
  Dim wb As Workbook
  Set wb = CopySheet(ActiveSheet)
End Sub

CopySheetの戻り値は、コピーで作った新規ブックになります。
新規ブックは、シートをMoveして作成しているので、シート数は1つです。

複数シートの処理や複数ブックの処理が必要な場合は、
Callする側で制御すれば、割と簡単に実装できるはずです。


書式のパターンは非常にたくさんあるので、全てをテストはしていません。
バグや考慮漏れの指摘があれば随時修正します。


こういう処理のVBAを書いていると良く分かることがあります。
それは、
Excelに機能があるからと言って、何でも使うのはどうかという事です。
出来る限り、
基本的な機能・誰でも知っている機能だけを使ってブック・シートを作ったほうが良いという事です。
そうすることで、
メンテナンス性も良くなるし、ファイルを誰かに引き継いだ時にも苦労しなくて済むという事です。




同じテーマ「マクロVBAサンプル集」の記事

罫線を簡単に引く(Borders,BorderAround)
マクロの開始・終了(Applicationのプロパティ)
オートフィルター(AutoFilter)
日付のオートフィルタ(AutoFilter)
印刷ダイアログを使用する(xlDialogPrint)
名前定義の一覧(Name)
シートを名前順に並べ替える
数式内の不要なシート名を削除する(HasFormula)
数式の参照しているセルを取得する
増殖した条件付き書式を整理統合する
条件付き書式で変更された書式を取得する

新着記事 ・・・新着記事一覧を見る

数値範囲で表検索するVLOOKUP近似一致|エクセル関数超技(10月5日)
エクセルVBAでのシート指定方法|VBA技術解説(9月8日)
VBAのクラスとは(Class,Property,Get,Let,Set)|VBA技術解説(8月28日)
VBAこれだけは覚えておきたい必須基本例文10|VBA技術解説(8月22日)
VBAの省略可能な記述について|ExcelマクロVBA技術解説(8月11日)
複数条件判定を行う時のコツ|ExcelマクロVBA技術解説(7月11日)
For Next の使い方いろいろ|VBA技術解説(6月14日)
VBAを定型文で覚えよう|ExcelマクロVBA技術解説(3月26日)
VBAスタンダード試験対策まとめ|MOS VBAエキスパート対策(3月16日)
ユーザーフォームとメニューの操作|MOS VBAエキスパート対策(3月14日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|ExcelマクロVBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.変数とデータ型(Dim)|ExcelマクロVBA入門
5.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
6.マクロって何?VBAって何?|ExcelマクロVBA入門
7.定数と型宣言文字(Const)|ExcelマクロVBA入門
8.繰り返し処理(For Next)|ExcelマクロVBA入門
9.とにかく書いて見よう(Sub,End Sub)|VBA入門
10.ひらがな⇔カタカナの変換|エクセル基本操作



  • >
  • >
  • >
  • 条件付き書式で変更された書式を取得する

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。





    このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

    本文下部へ

    ↑ PAGE TOP