[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『文字の点滅について』（とし）
多数の人が見る、一日の作業スケジュール表に、当日特に注意してもらいたい事項の文字を点滅させたいと思い、検索をして見つけたのを使用させて頂きたいと思います。
本当なら、オートシェイプを作ってそれを点滅させたいのですが、VBAはよくわからないので、EXCELのカメラ機能を使てやってみました。
すると、元々その作業スケジュール表には沢山のオートシェイプが貼り付けてあり、時間になるとそのオートシェイプ全てがチカチカとフラッシュしてしまいます。（文字の点滅等はしません）
文字が点滅するのは、設定してある４か所のカメラ部分だけです。
ちなみに、１か所にみにするとフラッシュせず大丈夫なのです。
これがコードです。
Option Explicit
Dim 開始時刻, 終了時刻, インターバル, 反復時刻
Sub 開始時刻から終了時刻まで一定間隔でマクロを実行する()
開始時刻 = TimeValue("06:00:00")
終了時刻 = TimeValue("19:00:00")
インターバル = TimeValue("00:15:00")
Application.OnTime 開始時刻, "一定間隔で実行するマクロ"
End Sub
Sub 一定間隔で実行するマクロ()
If TimeValue(Now) >= 終了時刻 Then '終了時刻になったら終わる
MsgBox "終了時刻になりました。"
Exit Sub
End If
Call 必要な作業を行うマクロ
反復時刻 = TimeValue(Now) + インターバル
Application.OnTime 反復時刻, "一定間隔で実行するマクロ"
End Sub
Sub 必要な作業を行うマクロ()
Dim selR As Range
Dim selId() As Integer
Dim selNum As Integer
Dim i As Integer, colorId(1) As Integer
Dim counter As Integer, setTime, flash
Set selR = Range("A85,I85,O85,T85") '点滅させるセル範囲
selNum = selR.Count
colorId(0) = 5 '点滅色
colorId(1) = 3 ' 〃
ReDim selId(1 To selR.Count)
For i = 1 To selR.Count
selId(i) = selR(i).Font.ColorIndex
Next i
For counter = 1 To 5 '点滅させる回数
For Each flash In colorId
selR.Font.ColorIndex = flash
setTime = Timer
Do
DoEvents
Loop Until Timer >= setTime + 0.4 '点滅の早さ
Next flash
Next counter
For i = 1 To selR.Count
selR(i).Font.ColorIndex = selId(i)
Next i
End Sub
何故、時間になるとカメラの４か所は文字が点滅させ、その他のオートシェイプはただチカチカとフラッシュしてしまうのでしょうか？
よろしくご教授をお願いいたします。
＜ 使用 Excel：Excel2010、使用 OS：Windows8 ＞
やってみたこと → VBAはよくわからないので、EXCELのカメラ機能を使てやってみました。
結果 → 時間になるとそのオートシェイプ全てがチカチカとフラッシュしてしまいます。（文字の点滅等はしません）
ということですか？
提示されたコードはVBAですよね？
カメラ機能とは何のことを指しているか不明ですが、
「図としてコピー」の機能のことではなさそうですね？
提示されたマクロを実行してみました。
結果、指定されたセルの文字が点滅します。
図（オートシェープ）はフラッシュ（＝点滅？）しません。
もう一度動作確認をされてみてはいかがでしょう。
一応、コードに変数が山ほど出てきて、
何が何だか分かり難いので添削してみました。（一例です。）
Sub 文字の点滅()
Dim t As Single
t = Timer
With ActiveSheet.Range("A85,E85,H85,T85")
Do Until Timer - t > 2
.Font.ColorIndex = IIf(.Font.ColorIndex = 3, 5, 3)
Application.Wait [Now() + "0:00:0.4"]
Loop
.Font.ColorIndex = xlAutomatic
End With
End Sub
ただし、このようなエクセルをカスタマイズするようなマクロは、
使わない方がいいと思います。
不具合が起きる可能性があるうえに、
「元に戻す」機能が使えなくなるからです。
（操作の履歴がマクロの実行で消える）
セルの背景を塗りつぶしておく、
あるいは、セルを囲む罫線の色を目立つ色に変える、
程度で十分だと思いますが。。。。
（まっつわん） 2017/01/20(金) 10:47
とりあえず、コード中で間違っているなぁ、と思ったのは、文字色を戻す部分。
Set selR = Range("A85,I85,O85,T85") ならば、エリアが4つあり、それぞれアイテムが1つずつという意味なので、文字色戻しは以下のようになるのでは？
selR.Areas(i).Font.ColorIndex = selId(i)
（???） 2017/01/20(金) 11:22
クイックアクセスツールバーのユーザー設定でリボンにないコマンド、あるいはすべてのコマンドで「カメラ」を追加できる。 (2003以前はメニューに入ってた思ったが）
選択した範囲を別の場所に図形としてリンク貼り付けするようなものだったはず。 （ねむねむ） 2017/01/20(金) 11:28
カメラ機能では、文字は画像としてコピーされてしまう（セルに図形を重ねてみれば判ると思います）のですが、背景色は変更できたので、点滅もできそうに思います。
（???） 2017/01/20(金) 11:59
カメラ機能とは、ねむねむ様の言う通りで、セルを図形として任意の場所に貼り付けています。
又、まっつわん様のコードで再度試しました。しかし、点滅らしき現象はでます。
今、気づいたのですが、この現象は、普通にマウスでオートシェイプを移動した時に、他のオートシェイプが
一瞬、１回だけ点滅するのですが、それがマクロで点滅させる回数分(5回)、一緒に点滅しているみたいです。
???様
確かに間違っていました。色が戻ってい所がありました。コード変更しました。
（とし） 2017/01/20(金) 13:07
あぁ、図としてコピーして、
リンクして貼り付けているということですか？
で、元のセルの色を変えれば、
当該図形の色も変わるであろうということですね？
あとで解決してなかったら、実験して考えてみます。。。
（まっつわん） 2017/01/20(金) 13:21
違うセルに貼ってしまうのも何ですし、カメラ機能案は駄目な気がします。
（???） 2017/01/20(金) 14:11
画像のほうが、大きくできて、分かり易いと思ったので、カメラでやってみましたが、
そうですか〜駄目ですか〜
では、表の中のセルで直接表示させたほうが良いですかね?
他に何か良い方でもあればよいのですが・・・
ご教授ありがとうございました。
（とし） 2017/01/20(金) 14:49
でもまぁ、いちいち点滅せずとも、他の文字が全て黒ならば、強調したい文字だけ色を付ければ、十分目立つと思うのですけどねぇ。 通常でもカラフルな画面になっているせいで、赤くした程度じゃ目立たなくなっているのでは？
（???） 2017/01/20(金) 14:59
色々と有難うございます。
スケジュール表は、全てオートシェイプが貼り付けてあり、シェイプの色で中の文字色が違います。
まぁ、ほとんどの文字は黒ですが。
でも、かなりカラフルな表になっているのは確かです。
なので、もしかしたら目立たないかも？です。
表の中には、空いているセルもあるので、そこだと罫線も関係なく、使用できます。
色々と試したいので、シェイプの枠や矢印を点滅させる方法をご教授願いませんか？
よろしくお願いします。
（とし） 2017/01/20(金) 16:20
Sub test()
Dim i As Single
Dim dw As Double
Dim s As Single
With ActiveSheet.Shapes(1)
For i = 0 To 4
For s = 0 To 1 Step 0.2
.Line.Transparency = s
dw = Timer + 0.1
While Timer < dw
DoEvents
Wend
Next s
For s = 1 To 0 Step -0.2
.Line.Transparency = s
dw = Timer + 0.1
While Timer < dw
DoEvents
Wend
Next s
Next i
End With
End Sub
矢印シェイプとかならば、線を無しにしておいて、.Line を .Fill に変えれば、今度は塗りつぶし領域が点滅します。
文字のときのように、色を変化させても良いですね。
任意の画像の場合は、.VisibleプロパティのTrue/Falseを交互に切り替えて点滅、とか。
アイデア次第であり、コードが知りたければ、マクロの自動記録でプロパティ操作を記録すれば良し。
（???） 2017/01/20(金) 17:19
Dim t
With Range("A85,E85,H85,T85")
With .Borders
.LineStyle = True
.Color = vbRed
End With
.Copy
t = Timer
Do Until Timer - t > 5
DoEvents
Loop
.Borders.LineStyle = False
End With
Application.CutCopyMode = False
End Sub
一応枠がチカチカしますが、
コピーの状態にしてるだけなので、
チカチカしてるときに貼付の操作をすると、
意図しないセルにセルがコピーされると思います＞＜
ちなみに、
図の数が少ないからでしょうが、
さっきのマクロで、
＞又、まっつわん様のコードで再度試しました。しかし、点滅らしき現象はでます。
こういう挙動は確認できませんでした。
かといって責任は取れないので、お勧めはしません。
何もしないのが、一番気楽だとは思いますが。。。
（まっつわん） 2017/01/20(金) 17:46
有難うございます。
早速、上記コードでやってみました。
スケジュール表には、シェイプが沢山あるからでしょうか？点滅の反応がありませんでした。
なにも無い、sheetでは、ちゃんと点滅が出来ていますが。
図形の形を決めた方が良いのでしょうか？
あと矢印もやってみました。
まっつわん様
有難うございます。
上記コードを試しましたが、特に変なフラッシュはありませんでした。
（とし） 2017/01/20(金) 20:22
お世話になっています。
ActiveSheet.Shapes(1) を(8)とかに数を増やしてもみましたが、100位のオートシェイプが貼ってあり、しかも毎日オートシェイプの数も違います。
使っているオートシェイプの形は、四角型や角丸四角形を使い、User Formで文字入りのオートシェイプが任意のセルに表示できるようになっています。
なので、使用していない、例えば台形(msoshape Trapezoid)とかを指定して、その形のみを対象として点滅させたいと思います。点滅場所は２か所です。
目的のシェイプを指定する方法を、ご教授下さい。
よろしくお願いします。
（とし） 2017/01/23(月) 12:39
とりあえず、台形なら全て配列に入れておいて、これらを同時処理する例なぞ。複数だと、2割変化ではズレて感じたので、1割変化にしてみてます。
Sub test()
Dim DIC As Object
Dim i As Long
Dim j As Long
Dim dw As Double
Dim n As Single
Dim S As Shape
Set DIC = CreateObject("Scripting.Dictionary")
For Each S In ActiveSheet.Shapes
If S.Name Like "Trapezoid*" Then
DIC.Add S.Name, S.ID
End If
Next S
For i = 0 To 4
For n = 0 To 1 Step 0.1
For j = 0 To DIC.Count - 1
With Shapes(DIC.keys()(j))
.Fill.Transparency = n
.Line.Transparency = n
dw = Timer + 0.05
While Timer < dw
DoEvents
Wend
End With
Next j
Next n
For n = 1 To 0 Step -0.1
For j = 0 To DIC.Count - 1
With Shapes(DIC.keys()(j))
.Fill.Transparency = n
.Line.Transparency = n
dw = Timer + 0.01
While Timer < dw
DoEvents
Wend
End With
Next j
Next n
Next i
End Sub
（???） 2017/01/23(月) 13:27
Sub test()
Dim DIC As Object
Dim i As Long
Dim j As Long
Dim k As Long
Dim S As Shape
Dim iCol() As Long
Set DIC = CreateObject("Scripting.Dictionary")
For Each S In ActiveSheet.Shapes
If S.Name Like "Trapezoid*" Then
DIC.Add S.Name, S.ID
End If
Next S
ReDim iCol(DIC.Count - 1, 1)
For j = 0 To DIC.Count - 1
With ActiveSheet.Shapes(DIC.keys()(j))
iCol(j, 0) = .Line.ForeColor.RGB
iCol(j, 1) = .Fill.ForeColor.RGB
End With
Next j
For i = 0 To 59
For j = 0 To DIC.Count - 1
With ActiveSheet.Shapes(DIC.keys()(j))
.Line.ForeColor.RGB = Array(RGB(128, 0, 0), RGB(128, 128, 0), RGB(128, 128, 128))(i Mod 3)
.Fill.ForeColor.RGB = Array(RGB(255, 0, 0), RGB(255, 255, 0), RGB(255, 255, 255))(i Mod 3)
For k = 0 To 999
DoEvents
Next k
End With
Next j
Next i
For j = 0 To DIC.Count - 1
With ActiveSheet.Shapes(DIC.keys()(j))
.Line.ForeColor.RGB = iCol(j, 0)
.Fill.ForeColor.RGB = iCol(j, 1)
End With
Next j
End Sub
（???） 2017/01/23(月) 15:58
色々とご教授有難うございます。
最初のコードでやってみた所、コンパイルエラーで「SubまたはFunctionが定義されていません」と出ました。
後のコードでは、インデックスが有効範囲にありませんとでて、
ReDim iCol(DIC.Count - 1, 1) ここの部分が黄色くなっています。
原因はなんでしょうか？
（とし） 2017/01/24(火) 01:37
色点滅の方は、DIC.Countが0ということでしょう。台形の図形を貼っていないのではないですか？
（???） 2017/01/24(火) 09:07
Sub test()
Dim i As Long
Dim j As Long
Dim k As Long
With ActiveSheet.Range("B2:D3,B6:F10")
For i = 1 To .Areas.Count
With .Areas(i)
With ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, .Left, .Top, .Width, .Height)
.Adjustments.Item(1) = 0.1
.Name = "点滅対象" & i
.Fill.Visible = msoFalse
End With
End With
Next i
For i = 0 To 59
For j = 1 To .Areas.Count
With ActiveSheet.Shapes("点滅対象" & j)
.Line.ForeColor.RGB = Array(RGB(255, 0, 0), RGB(255, 255, 0), RGB(255, 255, 255))(i Mod 3)
For k = 0 To 999
DoEvents
Next k
End With
Next j
Next i
For j = .Areas.Count To 1 Step -1
ActiveSheet.Shapes("点滅対象" & j).Delete
Next j
End With
End Sub
（???） 2017/01/24(火) 09:46
色々とご教授有難うございます。
エラーも無く、全て動いています。
お騒がせしました。
（とし） 2017/01/24(火) 20:49
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.