Excelで文字のフェードアウトをさせたい方法
- Excelで文字のフェードアウトをさせる方法について教えてください。
- セルに入力したテキストを、白から漸次黒に変わり、黒から漸次白に変わるように設定したいです。
- 現在試しているサンプルコードでは速すぎるので、もっとゆっくりさせる方法を教えてください。
- ベストアンサー
excel 文字をマクロでフェードアウトしたいのですがわかりません。
excelで文字のフェードアウトをさせたいです。 セルに入力したテキストを、 RGBで背景が白のセルに、白から漸次黒に変わり、黒から漸次白に変わるといった設定がしたいです。 自分で調べてなんとか記述してみたのが以下です。 Sub test1() Dim N As Integer Range("A1").Select With Range("A1") .Value = "" .Value = "Good luck!" .Font.Name = "Arial" For N = 255 To 0 Step -1 .Font.Color = RGB(N, N, N) Next N Application.Wait [NOW()+"0:00:00.5"] For N = 0 To 255 Step 1 .Font.Color = RGB(N, N, N) Next N .Value = "" End With End Sub これだと速いので、もう少しゆっくりさせたいのですが、 Application.Wait [NOW()+"0:00:00.1"] を細切れに挿入していくかしか、方法がわかりません。 御教授お願い致します！
- tkh_tkh
- お礼率85% (47/55)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
API関数を使ったらどうでしょう？ Sleep 1000 で1秒です。 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub test01() Dim N As Integer With Range("A1") .Value = "" .Value = "Good luck!" .Font.Name = "Arial" For N = 255 To 0 Step -1 .Font.Color = RGB(N, N, N) Sleep 10 Next N Sleep 100 For N = 0 To 255 Step 1 .Font.Color = RGB(N, N, N) Sleep 10 Next N .Value = "" End With End Sub
関連するQ&A
- このマクロあっていますでしょうか？よろしくお願いいたします。
★sheetＡ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$C$14" And Target.Address <> "$C$19" _ And Target.Address <> "$F$19" Then Exit Sub If Target.Address <> "$R$14" And Target.Address <> "$S$14" _ And Target.Address <> "$T$19" Then Exit Sub Application.EnableEvents = False With Sheets("Ｂ") .Range("F14").Value = Range("C14").Value .Range("F17").Value = Range("C19").Value .Range("F20").Value = Range("F14").Value .Range("F23").Value = Range("F19").Value End With With Sheets("Ｃ") .Range("F13").Value = Range("R14").Value .Range("F14").Value = Range("S14").Value .Range("F18").Value = Range("T19").Value End With Application.EnableEvents = True End Sub ★sheetＢ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$14" And Target.Address <> "$F$17" _ And Target.Address <> "$F$23" Then Exit Sub Application.EnableEvents = False With Sheets("Ａ") .Range("C14").Value = Range("F14").Value .Range("C19").Value = Range("F17").Value .Range("F19").Value = Range("F23").Value End With Application.EnableEvents = True End Sub ★sheetＣ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$13" And Target.Address <> "$F$14" _ And Target.Address <> "$F$18" Then Exit Sub Application.EnableEvents = False With Sheets("Ａ") .Range("R14").Value = Range("F13").Value .Range("S14").Value = Range("F14").Value .Range("T19").Value = Range("F18").Value End With Application.EnableEvents = True End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBA
VBAの素人です。 以下のようなVBAを実行しようと、何とか形にしました。 単独のBOOKではうまくいくのですが、同時に他のBOOKを開くと 「インデックスが有効範囲にありません」とエラーになります。 エラー箇所は、With Sheets("Sheet1").Range("B1")部分です。 修正をご教示頂ける方、何卒よろしくお願い致します。 全くVBA無知なのにすみません。 Private Sub Workbook_Open() test01 test02 Application.OnTime Now + TimeValue("00:10:00"), "終了" End Sub Sub 終了() Application.OnTime Now + TimeValue("0:00:02"), "test01", , False ThisWorkbook.Close Savechanges:=False Application.Quit End Sub Sub test01() With Sheets("Sheet1").Range("B1") .Value = Time .NumberFormatLocal = "mm:ss" End With Application.OnTime Now + TimeValue("0:00:02"), "test01" End Sub Sub test02() With Sheets("Sheet1").Range("B2") .Value = Time .NumberFormatLocal = "mm:ss" End With End Sub
- 締切済み
- オフィス系ソフト
- ExcelのVBAにつて（16進数から背景色への変換）
VBAを使って各セルの16進数の数値を背景色に変換したいのですがうまくいきません。 プログラムは以下のように書きました。 Sub graphic() With Cells .ColumnWidth = 1.0 .RowHeight = ActiveCell.Width .Interior.Color = &HFFFFFF .Font.Color = &HFFFFFF End With N = 1 For j = 0 To N - 1 For i = 0 To N - 1 For y = 1 To 200 Step N For x = 1 To 200 Step N With Cells(y + j, x + i) v = .Value r = Mid(v, 2, 2) g = Mid(v, 4, 2) b = Mid(v, 6, 2) c = Val("&H" + b + g + r) .Interior.Color = c .Font.Color = c End With Next Next Next Next End Sub Vista Home PremiumでExcel2007を使っています。 ここでセル内の数値は「#FFFFFF」このような形式です。 変換動作自体は行われるのですが、色の変換が行われず、白く虫食いのようになる部分があります。 数値を変更すると、別の部分の変換が行われなかったりします。 原因のわかる方がおられましたら教えていただきたいと思います。
- ベストアンサー
- その他（学問・教育）
- エクセルマクロでセルのコピー
困ってしまったので質問させてください Sub 一定秒おきに実行() Dim i As Integer For i = 1 To 10 Application.Wait Now() + TimeValue("00:00:10") コピーして別のシートに貼り付ける Next End Sub ---------------------------------- Sub コピーして別のシートに貼り付ける() Worksheets("sheet1").Activate Range("A1:G1").Copy ActiveSheet.Paste Destination:=Worksheets("sheet").Range("？？") End Sub ----------------------------------- 以上のようなコードがありますが Sheet1のA1:G1を10秒おきにSheet2の1行、２行、３行 と順番にコピーする Sub コピーして別のシートに貼り付ける() のコードを教えてください よろしくお願いいたします
- ベストアンサー
- オフィス系ソフト
- Excelマクロについて
先日、OKWEBで教えてもらったマクロに手を加えて作ろうとしたのですが、エラーがでて動かなくなりました。 わかる方がいましたら教えてください。 よろしくおねがいします。 Sub 見積書() Application.ScreenUpdating = False '見積書(完成)シートを選択 Sheets("見積書(完成)").Select '行の高さを「15」にする。 Rows("6:67").Select Range("F6").Activate Selection.RowHeight = 15 'S列のS6:S56をコピーしてE6:E7に貼り付ける。 Range("S6:S56").Select Selection.Copy Range("E6:E7").Select ActiveSheet.Paste '5列目(工数)が「0」のとき該当する行の高さを「0」にする。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" And Cells(i, 7).Value = "0" Then Rows(i).RowHeight = 0 End If Next '「E8:E55」の範囲を四捨五入する。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next 'C列の中に含まれる「小計」を検索しそこから6列目が「0」だったら行の高さを「0」にする。 Dim Rng As Range Const Retu = "C" For Each Rng In Range(Retu & "1", Range(Retu & "100").End(xlUp)) If Trim(Rng.Value) = "小 計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub
- 締切済み
- オフィス系ソフト
- Excelのセルのフォントサイズを自動調整
Excel97VBAの質問です。 セルの値が長すぎて表示しきれない場合は、フォントサイズを調整したい。 Sub Macro1() With Sheet1 .Columns("A").ColumnWidth = 1 .Range("A1").Value = 1 .Range("A2").Value = 12 .Range("A3").Value = 123 .Range("A4").Value = 1234 End With End Sub この場合、A2～A4の表示が潰れます。 フォントサイズを例えば、 Sub Macro2() .Range("A2").Font.Size = 7 .Range("A3").Font.Size = 5 .Range("A4").Font.Size = 3 End Sub と設定すれば潰れずに値が表示されます。 このようなフォントサイズの最適値を自動的に設定したい。 よろしくご指導お願いします。
- ベストアンサー
- Visual Basic
- エクセルVBAでPDF保存ができません
エクセルのシートを連続してPDFで出力するVBAで困っています。 自分の端末内で動かす分にはぜんぜん問題はありません。ところが会社のサーバー内の共有フォルダーに保存して動かすと、最初の1件だけは正常にPDFに保存されますが、何度やっても２件目でエラーになりPDFが保存されません。 「実行時エラー1004 ドキュメントを保存できませんでした。ドキュメントが開いているか、保存時にエラーが発生した可能性があります。」 となってしまうのです。 PDFが保存されないうちに次のPDFを作成して保存しているためかと思いApplication.Waitで10秒待つようにしたところ最後まで保存ができました。 しかし、自分の端末内ではWaitを入れなくとも問題なくできます。 質問は、この原因と、一律にApplication.Waitで10秒待たなくとも別の方法で対応する方法はないかということです。 よろしくお願いいたします。 Sub TEST01() '2020/10/10 Dim Fdr As String, Fn As String Dim n As Long With Sheets("Test") .Activate Fdr = ThisWorkbook.Path & "\" & Format(Date, "YYYYMMDD") & "-PDF" 'PDF保存先' If Dir(Fdr, vbDirectory) = "" Then MkDir Fdr '無ければ作成 End If For n = 1 To 20 .Range("C5").Value = Sheets("Data").Cells(n, "A").Value Fn = .Range("C5").Value & "_" & .Range("D5").Value 'ファイル名 Application.StatusBar = Fn & " PDFファイル作成中/" & n & "件目" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fdr & "\" & Fn & ".pdf" Application.Wait Now() + TimeValue("00:00:10") '10秒PDF保存完了を待つ（1-8秒では保存エラー） Next n End With Application.StatusBar = "" End Sub
- ベストアンサー
- Excel（エクセル）
- 指定の文字（記号）が入っているセルを点滅させる
現在 下のマクロを使い指定のセルの文字をエクセルが 開いたとき点滅させています（皆さんからのもらいものですが） これを 指定された文字（記号）たとえば ” ！ ” が入って いる セルのみを 点滅させたいのですが 列は一定です この場合は、Ｒ列です 指定の文字が入ったセルを点滅させるでもＯＫです マクロはちょこっとかじるぐらいしかわかりませんが よろしくお願いします。 Sub Auto_Open() Dim i As Long For i = 1 To 10 If Range("R33,R34").Font.Color = vbRed Then Range("R33,R34").Font.Color = vbBlack Else Range("R33,R34").Font.Color = vbRed End If Application.Wait Time + TimeValue("00:00:01") Next i End Sub
- ベストアンサー
- オフィス系ソフト
- マクロで分岐をさせる方法
下記の記録マクロでWith→End With 間にIFで分岐を試みたのですが エラーになります。どうすれば出来るのか伝授をお願いします。 マクロは初心者です。 Dim hensuh(2) As Integer Dim dekiru As Long Dim kinek As Long Dim uineu As Long Dim myTime As Date Dim flg As Boolean Sub OnTimeSamp1() Application.OnTime EarliestTime:=TimeValue("09:00:00"), Procedure:="Ontime_Set" '記録開始 Application.OnTime EarliestTime:=TimeValue("11:00:00"), Procedure:="Ontime_Reset" '記録終了 End Sub Sub Ontime_Set() 'トグルになっている If flg = False Then flg = True myTime = Now + TimeSerial(0, 0, 1) ElseIf flg = True Then flg = False Else Exit Sub End If If Range("A1").Value = "" Then Range("A1").Value = Format(Now, "hh:mm:ss") '時間記録（スタート) End If Application.OnTime EarliestTime:=myTime, _ Procedure:="my_Procedure", Schedule:=flg If flg = False Then myTime = 0 End If End Sub Sub my_Procedure() Worksheets("kirokuyou").Activate 'ワークシートをアクティブにする。（記録中別のワークシートを開けた場合そこに記録されてしまうのを防ぐ） With Range("A65536").End(xlUp).Offset(1) .Value = Format(Now, "yyyy:mm:dd:hh:mm:ss") '時間記録 .Offset(, 1).Value = Range("S3").Value 'S3 の値 .Offset(, 2).Value = Range("T3").Value 'T3 の値 .Offset(, 3).Value = Range("U3").Value 'U3 の値 .Offset(, 4).Value = Range("V3").Value 'V3 の値 dekiru = Range("V3").Value Range("V6").Value = dekiru kinek = Range("T22").Value Range("T18").Value = kinek uineu = Range("U22").Value Range("U18").Value = uineu 'IF S17 >= 120 Then 'hensuh(0) = Range("S17").Value ←変数に代入後、分岐させたいのですがエラーになる 'Elseif S17 >= 110 Then 'hensuh(1) = Range("S17").Value ←変数に代入後、分岐させたいのですがエラーになる 'Elseif S17 >= 100 Then 'hensuh(2) = Range("S17").Value ←変数に代入後、分岐させたいのですがエラーになる 'End If flg = False myTime = 0 End With Call Ontime_Set End Sub Sub Ontime_Reset() 'タイマーリセット On Error Resume Next Application.OnTime EarliestTime:=myTime, _ Procedure:="my_Procedure", Schedule:=False If Err.Number > 0 Then MsgBox "OnTime設定はされていません。", 64 Err.Clear flg = False Else MsgBox myTime & "の設定は解除されました。", 64 flg = False myTime = Empty End If End Sub
- ベストアンサー
- オフィス系ソフト
お礼
早速の御回答ありがとうございます！！！ 出来ました！ API関数というのがあるのですね。 調整も出来て、これだととても便利ですね！ ありがとうございます！！！