[[20160729130714]]　『オートフィルタで絞り込んであるセルに色を付ける』（ま）　ページの最後に飛ぶ

『オートフィルタで絞り込んであるセルに色を付ける』（ま）

 オートフィルタで絞り込まれているセルの色を変えるマクロを使っております
 （どこかからもらってきた記述）

 Private Sub xlWsht_Calculate()
  Static MyRng As Range
  Dim i As Long
  If ActiveWorkbook.ActiveSheet.AutoFilterMode Then
      With ActiveWorkbook.ActiveSheet.AutoFilter
          Set MyRng = .Range
          For i = 1 To .Filters.Count
              If .Filters(i).On Then
                  MyRng.Cells(i).Interior.ColorIndex = 3
              Else
                  MyRng.Cells(i).Interior.ColorIndex = xlNone
              End If
          Next i
      End With
  Else
      If Not MyRng Is Nothing Then
          For i = 1 To MyRng.Columns.Count
              MyRng.Cells(i).Interior.ColorIndex = xlNone
          Next i
      End If
  End If
  End Sub

 １列ずつ絞り込みがあるか確認し、色を変えています
 このマクロを使っていると、
 オートフィルタの行に元々色がついていた場合、
 クリアされてしまいます

 なので、
 　絞り込まれていなければ色をクリアにする
 というところを変えればよさそうなんですが

 そうすると、絞り込まれていない場合の色が何色か
 判断しておかないといけない　などとなり…

 考え方自体がよろしくないのかもしれませんが…^^;

 何か良い方法はありましたら教えてください

＜使用 Excel：Excel2003、使用 OS：Windows7 ＞

元ネタは、[[20060118155616]] ですかね？出典元なんて、使う人にとってはどうでも良いのですねぇ。最初に創造するのが大変なのに、寂しい話です。（駄目と言っている訳ではなく、文化とはそういうものだよなぁ、という感慨だけの話です）

で、元の色が消えてしまうとの事ですが、全ての列で同じ色になっているならば、xlNone にしている箇所を、他の色にすれば良いでしょう。または、絶対絞らない列の色と同じにするとか。

元の色が一色ではない場合、別のシートにタイトル部だけコピーしておき、その色に戻すとか。別シートを隠しておけば、邪魔にもならないでしょう。
（???） 2016/07/29(金) 13:30

 条件付き書式でセットしてはいかがでしょう。

    With ActiveSheet.AutoFilter
        Set myRng = .Range
        myRng.Rows(1).Cells.FormatConditions.Delete
        For i = 1 To .Filters.Count
              If .Filters(i).On Then
                myRng.Cells(i).FormatConditions.Add Type:=xlExpression, Formula1:="=1=1"
                With myRng.Cells(i).FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .ColorIndex = 3
                    .TintAndShade = 0
                End With
              End If
        Next
    End With

（β） 2016/07/29(金) 13:33

おぉ、βさん案面白いですね。条件付き書式の色は元の色より優先されるし、条件削除してしまえば元の色が出てくるし。

あとは、Worksheet_Calculate()にコードを書いておき、何でも良いから計算式が使われていれば、フィルタしただけで色が付くわけですね。ふむふむ。
（???） 2016/07/29(金) 13:58

βさん案の応用です。フィルタ解除時でもエラー停止しないようにしたのと、色表現を変えてみました。
（これは何人のアイデアの合体になるのでしょうね？）

 Private Sub Worksheet_Calculate()
    Static MyRng As Range
    Dim i As Long

    If AutoFilterMode = False Then Exit Sub

    With AutoFilter
        Set MyRng = .Range
        MyRng.Rows(1).Cells.FormatConditions.Delete
        For i = 1 To .Filters.Count
            If .Filters(i).On Then
                MyRng.Cells(i).FormatConditions.Add Type:=xlExpression, Formula1:="=1=1"
                MyRng.Cells(i).FormatConditions(1).Interior.Color = Int(MyRng.Cells(i).Interior.Color / 2)
                MyRng.Cells(i).FormatConditions(1).Font.Color = RGB(255, 0, 0)
            End If
        Next
    End With
 End Sub
（???） 2016/07/29(金) 14:29

 ???さん　ごめんなさい
 どこからサンプルを頂いてきたのかと思っていました
 失礼しました

 βさん　ありがとうございます
 応用を使わさせてもらっております

 Sheet1にVBAを追加する方法は
 必要な結果が得られたのですが

 このマクロをよく使っておりまして、
 アドインに追加しようとして止まっています

 頂いた記述を
 AddInsFile.xlaのThisWorkbookに追加しています

 ★の部分は追加しましたが、
 △のAutoFilter　で「変数が定義されていません」となります

 Private Sub Worksheet_Calculate()
    Static MyRng As Range
    Dim i As Long

	★↓
    If ActiveSheet.AutoFilterMode = False Then Exit Sub

    With AutoFilter　←△
        Set MyRng = .Range
        MyRng.Rows(1).Cells.FormatConditions.Delete
        For i = 1 To .Filters.Count
            If .Filters(i).On Then
                MyRng.Cells(i).FormatConditions.Add Type:=xlExpression, Formula1:="=1=1"
                MyRng.Cells(i).FormatConditions(1).Interior.Color = Int(MyRng.Cells(i).Interior.Color / 2)
                MyRng.Cells(i).FormatConditions(1).Font.Color = RGB(255, 0, 0)
            End If
        Next
    End With
 End Sub

 どう対応したらよいですか？
（ま） 2016/08/01(月) 15:46

アドインにするならば、元ネタと同様に、ActiveWorkbook と ActiveSheet を明示してみてください。
（???） 2016/08/01(月) 16:09

 こうしたらできるとか、できないとか、そういう話の前に。

 β自身はアドインは基本的に避けて通ってきました。
 環境が自宅のプライベートなものなのか職場のある意味パブリックなものかにもよりますが
 アドインを設定するということは、その機能を使う、使わないにかかわらず、【エクセルを立ち上げると必ず組み込まれている】
 ということになります。
 なので、本当に、普遍的にアドインにしておけば有効だろうというものに限って設定。
 （会社の業務で使う捺印だとか、カレンダー表示だとか）

 仮に、今回の処理が無事にアドインされ、使うことができたとします。
 そうすると、どんなエクセルブックであれ、開いて、そこに計算式があって、再計算されると
 このコードが実行されてしまいます。

 それって、困りませんか？

 ということで、すくなくとも、本件はアドインにはふさわしくないと思いますね。

 ところで

 >>AddInsFile.xlaのThisWorkbookに追加しています

 AddInsFile.xlaのThisRorkBookモジュールに、このコードをコピペしたんですか？
 シートモジュールであれば、Autofiler という名前のプロパティの参照が可能ですけど　ThisWorkbookモジュールや
 標準モジュールでは、シートオブジェクト.AutoFilter と、シート修飾が必要です。

 それいぜんに、ThisWorkbookモジュールにこのコードを貼り付けても動きませんよ。
 シートモジュールとThisWorkbookモジュールのイベントプロシジャの名前は異なりますので。

 で、さらに、イベントプロシジャの名前を正しくしたとしても、これは、AddInsFile.xla　というブックの中で
 再計算された場合のイベントですから、開いたブック側での再計算はキャッチされません。

 開いたブックのイベントをキャッチする書き方はありますが、そうすることは、コメントしたように
 適切ではないと思いますので、コード紹介はしません。

（β） 2016/08/01(月) 16:24

うん、私もアドインは嫌いで、普段一切使いませんね。アドインを組み込むと、Excelを起動する度に読み込みが発生するので遅くなりますし、環境を変えるとエラーになるし、後々トラブルの元になりがちなのです。
（存在が空気になってしまうので、利用者にアドイン利用しているという意識がないのです…）

必要なブックだけ、ThisWorkbook にマクロを組み込むのが良いですねぇ。
（???） 2016/08/01(月) 17:15

 >>必要なブックだけ、ThisWorkbook にマクロを組み込むのが良いですねぇ。

 それが、まっとうな（？）方法だと思いますね。
 そうすることで、このブックに関する再計算だけが処理されますから。

 どうしても、別モジュールでということなら、（記述方法は、ちゃんとしたものにしておく必要はありますが）
 参照設定でしょうかね。

（β） 2016/08/01(月) 17:28

 βさん???さん
 遅くなり＆勉強不足ですみません

 おかげさまでThisWorkbookの使い方は理解できました
 今回は、アドインの追加はしないようにします

 しかし…このマクロは使い勝手が良く、
 とても気に入って使っていますので
 汎用性があるようにできるといいなと思っています

 そこで、βさんの書いて下さった
 参照設定について調べてみました
 参照設定をチェックをすることくらいは知っているのですが

 実際はどのようにすればよいのでしょうか

 上記に頂いたマクロファイルを作成し、（txtか何か？)
 参照しにいくといった方法なのでしょうか

 どこか確認できるようなページなどありましたら
 教えていただけると助かります
（ま） 2016/08/15(月) 15:04

横から茶々入れ。
＞参照設定をチェックをすることくらいは知っているのですが
＞実際はどのようにすればよいのでしょうか
参照設定のWindowsに「参照」ボタンというのがありますね。
それをクリックして、マクロがあるExcelファイルを選択指定する、
ということでしょう。

（γ） 2016/08/15(月) 16:48

 参照設定に関してはγさんからのレスの通りです。
 ブックの形としては xlsmブックでもいいですし、あるいは xlamの形にしておいてもいいのですが
 いずれにしても、このマクロブックを参照設定すればいいんです。

 ただし、参照設定をする際の約束事が１つ。
 マクロブック内のマクロ全体をプロジェクトと呼び、このプロジェクトに名前が付いています。
 何もしなければ VBAProject という名前になっています。

 通常は VBAProjectのままでも支障はないのですが、参照設定をする場合は、このプロジェクト名がユニークである必要があります。
 ですから、参照設定を目的にしたマクロブックの場合、VBA画面の左下のほうにあるプロパティ画面のオブジェクト名を
 なにかしらユニークなものに変更しておく必要があります。

 そういうこともありますし、また以下のようなこともありますので、当面は、共通機能としての組み入れはしばらく延期されたほうが
 よろしいかと思いますよ。

 たとえば新規ブックのThisWorkbookモジュールに以下を書き、いったん名前を付けて保存。

 Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    MsgBox Sh.Parent.Name & vbLf & Sh.Name
 End Sub

 このマクロブックがアドインなり参照設定なり、とにかく共通で使いたいものですよね。

 ・このブックを開いてください。
 ・その上で、新規ブックを立ち上げるなり既存のブックを開くなりしてください。
 ・その新規ブックなり既存のブック上で、何か計算式を入れてみてください。

 まったく反応しませんよね。
 先にレスした通り、このコードは、それが書かれたマクロブック内の再計算にしか反応しません。
 これでは意味がないですね。

 マクロブックのコードを消して、以下を貼り付けてください。

 Dim WithEvents xlApp As Application

 Private Sub Workbook_Open()
    Set xlApp = Application
 End Sub

 Private Sub xlApp_SheetCalculate(ByVal Sh As Object)
    MsgBox Sh.Parent.Name & vbLf & Sh.Name
 End Sub

 いったんマクロブックを保存し、再度開いたうえで、新規ブックを立ち上げるなり
 既存ブックを開くなりして、それらの上で何か計算式をいれてみてください。

 今度は反応しましたね。しかも、どのブックで再計算されたのかという情報も取得できます。

 本件を、共通処理ツールとして組み入れるには、まず、このあたりの仕掛けを十分に理解してからにされたほうが
 よろしいかと思います。

（β） 2016/08/15(月) 19:38

 念のため補足しておきます。

 共通で使いたいマクロがあって、それを【単独のマクロブック】として保持しておいて
 それを、呼び出して使う、アドインにしておいて使う、参照設定して使う、いずれにしても
 エクセル区画内のマクロモジュールというポイントで眺めると

 共通マクロブック ThisWorkbookモジュール
　　　　　　　　　Sheetモジュール
　　　　　　　　　UserFormモジュール
　　　　　　　　　Classモジュール
　　　　　　　　　標準モジュール
 通常ブック　　　 ThisWorkbookモジュール
　　　　　　　　　Sheetモジュール
　　　　　　　　　UserFormモジュール
　　　　　　　　　Classモジュール
　　　　　　　　　標準モジュール

 こうなっています。（当たり前ですけど）
 決して

 通常ブック　　　 ThisWorkbookモジュール　<== 何も記述していないけど、別のどこかのThsWorkbookモジュールの内容を継承
　　　　　　　　　Sheetモジュール　　　　<== 何も記述していないけど、別のどこかのSheetモジュールの内容を継承
　　　　　　　　　UserFormモジュール　　　<== 何も記述していないけど、別のどこかのUserFormモジュールの内容を継承
　　　　　　　　　Classモジュール　　　　<== 何も記述していないけど、別のどこかのClassモジュールの内容を継承
　　　　　　　　　標準モジュール　　　　　<== 何も記述していないけど、別のどこかのT標準モジュールの内容を継承

 という構造ではありません。
 自ブックで、特定の処理をしたい場合は、あくまで自ブックのモジュール内に、別途、記述しておいたロジックなりプロシジャなりを
 コピペして【自ブック内に】取り込んでおくことが必要です。
 別途の記述は、単なるコピペもとですから、エクセルブックのモジュールの形でストックしておいてもいいですし、
 あるいは、テキストファイルのようなものでテキストとして保持しておいてもよろしいですが。

 この構造ですから、わかりにくいかもしれませんが、ThisWorkbookモジュールやSheeetモジュールにおけるイベント処理を
 共通ブックとして書いておいて利用するのは、使い方が、きわめて困難、相当に使い方に配慮したものにする必要があります。

 ★ですから、少なくともイベント処理に関しては、共通処理の別マクロブック仕立てという構造は
 　もう少し慣れてからチャレンジされるテーマかなと思います。

（β） 2016/08/16(火) 08:41

コメント返信：

[ 一覧(最新更新順) ]

[[20160729130714]] 『オートフィルタで絞り込んであるセルに色を付ける』（ま） ページの最後に飛ぶ

[[20160729130714]]　『オートフィルタで絞り込んであるセルに色を付ける』（ま）　ページの最後に飛ぶ