0

ワークブックのさまざまなワークシートでエクスポート マクロを開発中です。そうは言っても、指定された範囲（名前付き範囲）の値とそれらが保持するカラーフォーマットを条件付きフォーマットからエクスポートするには、エクスポートマクロを含むワークシートが必要です。

必要のないことの 1 つは、カラーリングを作成した条件付き書式をコピーすることです。範囲内のさまざまなセルの結果の色のみが必要です。

以下のコードを実行しましたが、ロールアップ ファイルを開くと、問題のすべてのセルに条件付き書式パターンが関連付けられているため、色の問題が発生します。

ws.range("rngAreaMetricDetail").Copy   'Area Mgr Store Metrics
newws.range("V3").PasteSpecial xlPasteValues    'Paste Values
newws.range("V3").PasteSpecial xlPasteFormats  'Paste Coloring
newws.Names.Add "rngAreaMetricDetail", Selection   'Create Named-Range from Selection

事前にサンクス。

4

3 に答える 3

2

Excel には、条件付き書式を条件付き書式の結果に変換する簡単な方法がありません。すべてを手動で行う必要があります。

  • 各セルで FormatCondition が使用されているかどうかを確認します。
  • FormatCondition からフォーマットを手動で割り当てます。( Borders, Font, Interior, & NumberFormat)
  • 複数の FormatCondition がある場合、StopIfTrueが設定されていない限り、後者の形式が前の形式をオーバーライドします。

Microsoft Word がインストールされている場合は、範囲を Word にコピーして Excel に戻すことができ、Word で形式を変換できます。

Sub CopyConditionalFormattingThruWord(sAddress As String)
   Dim appWord As Word.Application, doc As Word.Document
   Dim wbkTo As Workbook

   ' copy from original table
   ThisWorkbook.Activate
   ThisWorkbook.Names!rngAreaMetricDetail.RefersToRange.Copy

   ' paste into word application and recopy
   Set appWord = New Word.Application
   With appWord
      .Documents.Add DocumentType:=wdNewBlankDocument
'      .Visible = True
      .Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
      .Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
      DoEvents
      .Selection.Copy
   End With

   ' copy to new workbook
   Set wbkTo = Excel.Application.Workbooks.Add
   wbkTo.Worksheets(1).Range(sAddress).Select
   wbkTo.ActiveSheet.Paste
   DoEvents

   ' close Word
   appWord.Quit SaveChanges:=False

   MsgBox "Done."

End Sub

注:これはフォーマットを 100% 正しくコピーするわけではありませんが、ほとんどの場合、これで十分です。以下の例では、左側の表の行 1 ～ 9 に 3 つの条件付き書式が適用されています。右の表は を実行した結果です CopyConditionalFormattingThruWord sAddress:="B3"。

上記のコードの実行例

Excel 2010: Excel 2010 を使用していて、Word を使用したくない場合は、範囲の新しいDisplayFormatメンバーを使用して FormatCondition テストをスキップできます。ヘルプ ファイルから:

範囲の条件付き書式やテーブル スタイルの変更などのアクションにより、現在のユーザー インターフェイスに表示される内容が、Range オブジェクトの対応するプロパティの値と一致しなくなる可能性があります。DisplayFormat オブジェクトのプロパティを使用して、現在のユーザー インターフェイスに表示される値を返します。

Borders、Font、Interior、 &NumberFormatなどから手動で値を割り当てる必要があります。

于 2012-05-02T17:40:18.977 に答える
0

これはあなたがしようとしていることですか？

あなたがチェックしている条件は1つだけだと思います。エラー処理は行っていません。あなたもそれを大事にしてくれることを願っています。

Option Explicit

Sub Sample()
    Dim ws As Worksheet, newws As Worksheet

    Set ws = Sheets("Sheet1")
    Set newws = Sheets("Sheet2")

    '~~> Area Mgr Store Metrics
    ws.Range("rngAreaMetricDetail").Copy

    newws.Activate

    '~~> Paste Values
    Range("V3").PasteSpecial xlPasteValues

    Selection.Interior.ColorIndex = GetColor(Range("rngAreaMetricDetail"))
End Sub

Public Function GetColor(rng As Range)
    Dim oFC As FormatCondition

    Set rng = rng(1, 1)
    If rng.FormatConditions.Count > 0 Then
        For Each oFC In rng.FormatConditions
            GetColor = oFC.Interior.ColorIndex
            Exit For
        Next oFC
    End If
End Function
于 2012-05-02T14:33:08.937 に答える