[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロが実行されなくなった。』（mach）
こちらで、お世話になりスケジュール表示機能をエクセルマクロで完成できました。順調でしたが、ここ一か月ほど半日ごとにExcelを立ち上げ直さないとサーバーにあるファイルを自動更新しなくなっており、どうしたものかと考えていたところ、今日は全く更新しなくなってしまいました。
上記症状はスケジュール表示専用のPCの話でWIN10以外にはExcelとACBAT Readerぐらいしか入っておりません。
他のPCで同じファイルを開くと問題なく動きますので、ファイルは正常だと考えております。
確認すべきポイント等あれば教えていただけないでしょうか？
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
オブジェクト、特にブックやシートの開放が甘くて、リソースを使い切ってしまう、というのは、未熟な人が良くやる事です。 まずはタスクマネージャを見てみては？
（???） 2020/06/29(月) 16:08
いつもありがとうございます。
タスクマネージャー上では
CPU50%未満
メモリー67%です。
メモリーについてはMS純正ツールで15分に一回メモリーを解放させています。
今日はエクセルの立ち上げ直し、PCの再起動、どれをやってもリカバーせず悩み中です。
マクロは公開できる形にしてから、見ていただけるならお願いしたいと思っております。
（mach） 2020/06/29(月) 16:21
過去に見た駄目な例としては、ファイル数分ループし処理するマクロがあったのですが、ブックをCloseする処理が無かったため、次々とブックを開き、全部のブックを開いて、処理成功するとプロシジャを抜ける事で、全部自動Closeしていました。
対象ファイルが毎日少しずつ増加していったため、そのうちに全部開くのにリソースを探しまくるようになり、数十分固まるようになりました。 これを、1ブック終わる度にCloseするようにするだけで、あっという間に終了するように…。
（???） 2020/06/29(月) 17:57
ご推察のとおり、empty.exeです
このBOOK（閲覧)はサーバーにおいてあり、同じサーバーの同じ階層にある他の
BOOK(オリジナル）のデータを参照しています。
PCで見に行くだけであり、 同じBOOK（閲覧）が特定のPCだけで
うまく動かないのがよくわからないところです。BOOKを開いているのはどれか1台
だけであり、複数のPCから同時にアクセスはしていません。
この動かなくなった特定のPCこそが大型モニター用の表示に使ってるいるPCなので
頭を抱えています。
Book（閲覧)の構成は
１ モニター画面（最大１２の当日予定を表示できる構成です）
２ Sheet1
2(1) 状況表 2(2) 更新データ ３ NOスケジュール用画像保存 と５つのシート構成となっており、PC上で常時見えているのは「１ モニター画面」シートになります。
予定がある場合はサーバーにあるの値を「2(1) 状況表」と「2(2) 更新データ」で吸い上げ
「２ Sheet1」に流し込み条件をつけて並び替えを行い、その結果を「１ モニター画面」に
反映しております。
予定がない場合は「３ NOスケジュール用画像保存」にある画像を「１ モニター画面」シートに
表示するようにしてあります。
モニター画面に表示するのは、それぞれのユニットの
現状ステータス、ユニットの種類、担当者、計画時刻（開始、終了、所要時間）、実時間（開始、終了、経過時間）、行動エリア等です。
徐々に拡張していったマクロなので無駄なところが多々あるとは思いますが、以下の通りです。
■メインモジュール■
Sub Auto_Open()
Dim wb As Workbook, c As Range Dim str As String
Application.ScreenUpdating = False '画面更新の抑止 str = "" Set wb = Workbooks.Open(ThisWorkbook.Path & "\長期お知らせ .xlsm")
Windows(wb.Name).Visible = False wb.Close SaveChanges:=False Application.ScreenUpdating = True '画面更新の抑止解除
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources 'リンクを更新
Call Macro1 '12秒毎に更新
Call Macro2 '当日情報+長期お知らせ読み込み1列に
Call Macro3 'テロップを流す
End Sub
Sub Macro1() '12秒毎に更新
Dim TargetTime
Calculate
TargetTime = Now + TimeValue("00:00:12") '秒数はここで変える
Application.OnTime TargetTime, "Macro1" '12秒毎に更新
Application.OnTime TargetTime, "後列へ"
Dim ReturnBook As String
ReturnBook = ActiveWorkbook.Name '現在開いているブックを記録
Application.ScreenUpdating = False '現在のブックの裏で以下の操作を実施
ThisWorkbook.Activate '予定表をアクティブ化
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources 'リンクを更新
Cells(1, 1).Select
Workbooks(ReturnBook).Activate 'もともと開いていたブックをアクティブ化
Application.ScreenUpdating = True
Worksheets("モニタ画面").Activate
Call Macro2 '当日情報+長期お知らせ読み込み1列に
End Sub
Sub Macro2() '当日情報+長期お知らせ読み込み1列に
Dim r As Range
Dim ss As String
With Application
For Each r In [C21:AB21].Rows
ss = .Trim(Join(.Index(r.Value, 0#)))
r.Cells(3, 1).Value = Replace(ss, " ", " ") '（4、1）はC21を基準にしてC23
Next
End With
End Sub
Sub Macro3() 'テロップを流す(当日情報+長期お知らせが順番に流れる）
Dim ip As Long Dim cw As String Dim iEnd As Single
Do
cw = Range("C23") 'テロップを読み込むセルを指定
iEnd = Timer + 0.1 'テロップ速度を指定 数値大きくなると遅くなる
3 ip = ip Mod Len(cw) + 1
Range("P2") = Mid(cw & cw, ip, Len(cw)) 'テロップを流すセルを指定
While Timer < iEnd
DoEvents
Wend
Loop
End Sub
Sub 後列へ()
'
' 後列へ Macro
' 終わった予定は最後列へ移動
'
With Worksheets("Sheet1")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("L66:L77") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("C66:C77") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"SKY4,MARINE1,SKY2,MAMA1,DISH2,SKY1,TAIL7,DISH7,KIRI7,NINJYA1,SWEEPER1,SHIRONEKO1,KEEPER1,BOOK7", _
DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("D66:D77") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("G66:G77") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SetRange .Range("B65:X77")
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.Apply
End With
End Sub
Sub auto_close()
Dim TargetTime
Dim i As Long
On Error Resume Next
For i = 1 To 60
TargetTime = Now + TimeValue("00:00:" & Application.Text(i, "00"))
Application.OnTime TargetTime, "Macro1", , False
Next i
If ThisWorkbook.ReadOnly = True Then
ThisWorkbook.Close SaveChanges:=False
End If
End Sub
■モジュール2■(定期的にempty.exeを起動）
Sub メモリークリアー()
CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\empty.bat"
End Sub
■モジュール3■
Sub NoSchedule表示()
Dim shpPic As Shape
Dim strPath As String
strPath = "\\server\NoSchedule.jpg"
Worksheets(1).Shapes.AddPicture _
Filename:=strPath, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=180, _
Top:=190, _
Width:=1098, _
Height:=389
Worksheets(1).Shapes.AddPicture _
Filename:=strPath, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=1700, _
Top:=190, _
Width:=1098, _
Height:=389
End Sub
■モジュール4■
Public Sub AddPictureSample()
'--- 読み込む画像ファイルのパス ---'
Dim pictPath As String
pictPath = "noflt.jpg"
'--- 読込先のワークシート ---'
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("モニタ画面")
'--- 画像の挿入位置 ---'
Dim posLeft As Long
Dim posTop As Long
posLeft = 190
posTop = 180
'--- 画像の挿入 ---'
Dim shpObj As Object
Set shpObj = ws.Shapes.AddPicture( _
Filename:=pict, _
LinkToFile:=msoTrue, _
SaveWithDocument:=msoFalse, _
Left:=posLeft, _
Top:=posTop, _
Width:=-1, _
Height:=-1 _
)
'--- 画像の挿入位置 ---'
posLeft = 1700
posTop = 180
'--- 画像の挿入 ---'
Set shpObj = ws.Shapes.AddPicture( _
Filename:=pictPath, _
LinkToFile:=msoTrue, _
SaveWithDocument:=msoFalse, _
Left:=posLeft, _
Top:=posTop, _
Width:=-1, _
Height:=-1 _
)
End Sub
■モジュール5■
Sub Delete_NoSchedule()
Dim myShape As Shape
For Each myShape In ActiveSheet.Shapes
''エクセルシート上で「画像」を削除する
If myShape.Type = msoPicture Then
myShape.Delete
End If
Next
End Sub
■sheet4■
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End Sub
Private Sub Worksheet_Calculate()
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
With Me.Sort
.SetRange .Rng.CurrentRegion
.Apply
End With
End Sub
Private Sub Worksheet_Deactivate()
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
■ThisWorkbook■
Private Sub Workbook_Open()
Application.DisplayFullScreen = True
Me.Worksheets(1).Sort.Apply
End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayFullScreen = False
Me.Save
End Sub
分かりにくいとは思いますが、アドバイスがいただければ幸いです。
（mach） 2020/06/30(火) 11:57
まずは、要所にログを出力するようにして、思った通りに実行しているか確認してみてください。 処理の開始/終了の記録ですね。
普通は、Debug.Printでイミディエイトウィンドウにログ表示で十分ですが、Close時の処理が気になるので、テキストファイル出力の方が良いかも？（Closeしてしまうとイミディエイトウィンドウ見られなくなるし）
アクティブなブックやシートを使っているので、ログにはアクティブなブック名とシート名が必要でしょう。
ぱっと見で気になったのは、auto_closeの処理の中に、リードオンリーだった場合は ThisWorkbook.Close するとあるのですが、無限にCloseを繰り返しませんか？ これが原因ならば、リードオンリーを止めれば良いだけみたいですが。（動かしっ放すからCloseに行かず問題になってない、とかですかね？）
OnTimeのキャンセルも、60秒分総当たりしていて無駄だし…。（TargetTimeを共通変数にして覚えておけば良いだけ） ハズレをキャンセルした瞬間に秒が進んで、目的の時間を1秒飛ばしてしまいアタリがキャンセルされず、指定時刻になってイベント発生して、終わるはずだったブックが再起動してきたり…、とか、絶対無いと言い切れるのでしょうか？ なかなか起こらないけどたまにおかしくなる、とかになりそうな、危ない設計に見えます。
そして、テロップを流す事がメインならば、C#やVB.NET等で作って、Excelブックは外部オブジェクトとして参照するだけにした方が良さそうに見えます。 Excelは所詮、表計算アプリであり、動かしっ放し運用には向きません。 Excelでテロップを流すのは、デモとかプレゼン用途くらいであり、常時実行するような安定性は無いと思います。
（???） 2020/06/30(火) 13:45
ありがとうございます。
Debug.Print、イミディエイトウィンドウなど初めて聞く単語なのでこれから勉強します。
メインはスケジュールの進捗状況になります。
情報のテロップ化は限られた画面の有効活用をしようと始めました。
ちゃんとしたプログラムで作りたいとは考えていたのですが、突貫工事から始まったので
オリジナルデータがExcelだったのでまずはExcelで始めた次第です。
今日の不具合探求で判明したことは、表示用PCはNOTEを使っており、外部ディスプレイアダプター（USB)を使用して55インチ2画面に拡張表示させ、NOTE画面は殺しています。
外部ディスプレイをはずしてNOTE PCだけにすると正常に作動しました。
外部ディスプレイを接続することでマクロが実行できない（以前はできた）ということは
考えられるのでしょうか？
怪しいとしたら外部ディスプレイアダプター（USB)かなとは思うのですが・・・
（mach） 2020/06/30(火) 16:18
USB接続の場合、特にUSB2だと転送速度が遅いので、表示更新をひっきりなしに送る事で、転送できる限界を超えてしまったのではないかと思います。（USB→映像信号変換用チップのバッファを超えた）
テロップ部分は、DoEventsを入れてはいますが、Excelが全力でCPUを使いながら表示更新してますよね？ これ、セットする文字列に変化があった時だけ実際に文字列セットするように変えませんか？ 中身が同じでもセル代入しているので、Excelとしては同じ文字列で表示更新するし、描画メッセージが飛びますよ。
（???） 2020/06/30(火) 16:44
止める時間を長くして、テロップを遅くするしかないかも？（カクカクしますが、遅くした分、2文字ずつずらすとか）
（???） 2020/06/30(火) 16:51
マクロを変えずとも、HDMIかRGB接続のディスプレイに変えれば良いだけですかねぇ。
（???） 2020/06/30(火) 16:59
ハードや設定を色々と検証した結果、暫定ですが表示を復活させることができました。
おそらく、USB to HDMI変換アダプターの能力劣化が原因です。
（映像信号変換用チップでしょうか）
このアダプターはUSB Type-A3.1Gen(USB3.0)からHDMI2.0入力(2画面 ４K＠60Hz）へ
変換するもので使用しているNotePCはUSB3.0となっています。
これを使い、55インチ2枚左右に４K（200%表示）で拡張表示させていました。
＞Excelが全力でCPUを使いながら
このキーワードがヒントとなり、表示を２K（100％）にディグレードさせてみたところ
表示がサーバーの元データの更新にタイムリーに追従し復活となりました。
暫定と書いたのは、４Kの時の表示に比べると画面が汚いので、完全復活ではないためです。
CPU能力を超えているのかもという気もしますが、半年間はノーマルだったのに今週になって全く動かなくなったのでアダプターが原因だと考えています。
Timer + 0.1とUPしましたが先週までは0.4にしていました。今週になり、表示が遅いというコメントが多く出たので変更していました。
以前は0.4で実用に供するスピードでしたので。
HDMIポートから映像信号を出す方法に変更しようと思いましたが、2画面ですとスプリッターかませせても複製しかできず、拡張表示ができないのかなと思っています。できる方法があれば移行したいとは思いますが。
アダプターは保証期間中なので、交換できれば完全復活かなと思っています。
以下の文は削ってみました。とくに不具合ないので、不要な構文だったようです。
If ThisWorkbook.ReadOnly = True Then
ThisWorkbook.Close SaveChanges:=False
End If
まずは、ご報告まで。
（mach） 2020/07/02(木) 16:39
気になったのが、USB3の変換アダプターのようですが、ノートPC側はUSB3のポートを使ったでしょうか？ あるポートはUSB3だけど、別のポートはUSB2、というノートPCは結構ありますから。（丸いコネクタなら間違えませんが、大きい長方形型のだと同一サイズですから）
（???） 2020/07/02(木) 16:48
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.