2012-05-02 28 views
0

私はブック内のさまざまなワークシートにエクスポートマクロを開発中です。つまり、私は指定された範囲(名前付き範囲)の値とそれらが条件付きの形式から保持するカラーフォーマットの値をエクスポートするために、エクスポートマクロを持つワークシートを持つ必要があります。値をコピーして貼り付け - ぬりえで

私が必要としないことは、着色を作成した条件付きフォーマットをコピーすることです。私は範囲内のさまざまな細胞の結果としての色が欲しいだけです。

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

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 

前もってThanx。

答えて

2

Excelに条件付き書式を条件付き書式の結果に簡単に変換する方法はありません。

  • 各セルでFormatConditionが使用されているかどうかを確認してください。
  • FormatConditionから手動でフォーマットを割り当てます。複数のFormatConditionを持っている場合はStopIfTrueが設定されていない限り(BordersFontInterior、& NumberFormat
  • 、後者の形式は、以前のものを上書きします。

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"を実行した結果です。

example of running the above code

エクセル2010: は、Excel 2010を使用していた、とWordを使用したくなかった場合は、範囲の新しいDisplayFormat部材を用いてFormatConditionテストをスキップすることができます。ヘルプファイルから:

な 範囲の対応するプロパティの値と一致しないことが に現在のユーザー・インターフェースに表示されているものを引き起こす可能性があります 範囲の条件付き書式や表スタイルの変更など

アクションオブジェクト。 DisplayFormatオブジェクトのプロパティを使用して、現在のユーザーインターフェイスに表示されている値を に返します。

あなたはまだ Font、手動でその Bordersから値を割り当てる必要があり

Interior、& NumberFormatなど

+0

+1よくできて:) –

+0

実際に問題の解決策は、(Ctrl + A + A + Aのように)ワークシート全体をコピーして貼り付け、すべての色付けと特定のフォーマットをコピーすることでした特定の条件付き書式設定は必要ありません。なぜ私に聞かないでくださいが、それは動作します。 – GoldBishop

+0

あなたが述べたように、セルベースでは(少なくともUsedRangeで)ほとんどセルごとに評価する必要がありますが、これはアブストラクトとしてではなくセルレベルで条件付きフォーマットを公開するような最善の方法ですワークシートの分離された部分。 – GoldBishop

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 
+0

コードでは、指定されたセルでフォーマットが使用されているかどうかはチェックされません。 – mischab1

+0

はい、あなたは正しいです。そのためには、条件が満たされているかどうかを確認するために上記で与えた関数で余分なチェックをする必要があります。条件が満たされている場合は、色を取得しておきます。 –

+0

実際には、このリンクhttp://www.cpearson.com/excel/CFColors.htmが表示されている場合は、条件付き書式設定について詳しく説明しています。 –

0

このコードを試してみてください...古い私は時々使用します。私はあなたにそれを良いものにするためにいくつかのことをしなければならなかった。

Sub move() 
Dim lrow As Long 
Dim lrow2 As Long 
Dim rng As Range 

Sheets(3).Cells.Clear 


With Sheets(1) 
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row 
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9)) 
    rng.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 
End With 

With Sheets(3) 
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row 
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9)) 
    rng.Interior.Color = vbYellow 
End With 

With Sheets(2) 
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row 
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9)) 
    rng.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 
End With 

With Sheets(3) 
    lrow2 = .Cells(Rows.Count, 1).End(xlUp).Row 
    Set rng = Range(.Cells(lrow2 - (lrow - 2), 1), .Cells(lrow2, 9)) 
    rng.Interior.Color = vbRed 
End With 

End Sub 
関連する問題