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

公開日：2018-02-16　最終更新日：2018-02-16

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

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

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

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

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

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

実際の画像

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

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

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

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

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

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

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

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

想定シーン

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

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

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

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

問題点

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

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

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

解決方法

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

2.配色のカラーを固定カラーに再設定
　　配色を使用したカラー設定を固定カラーに再設定

Excel2007以降なら配色を選択して作成した場合、作成したシートを他のブックに移すと色が変わってしまいます、そこで、配色ではなくRGB値で色を再設定することで、元々の色をそのままにして、他のブックに移すことが出来るようにします。以下は、この目的で色を再設定するマクロVBAになります。

　　ここでは、グラフの色も変更しています。

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サンプル集」の記事

シートを名前順に並べ替える
 数式内の不要なシート名を削除する（HasFormula）
数式の参照しているセルを取得する
 増殖した条件付き書式を整理統合する
条件付き書式で変更された書式を取得する
セル結合/解除でセル値を退避/回復
 セル結合なんて絶対に許さないんだからね
 セルの数式をネスト色分けしてコメント表示
 セル結合して表を見やすくする（非推奨）
シートを削除：不定数のシート名に対応
 セル番地でバラバラに指定されたセルの削除

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.ブック・シートの選択（Select,Activate）｜VBA入門

ホーム
マクロVBA応用編
マクロVBAサンプル集
条件付き書式で変更された書式を取得する

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

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

VBAサンプル集
条件付き書式で変更された書式を取得する