screenupdatingが機能しなくて困ってます

質問

お願いします。
長文失礼します。

下記マクロを実行しても、screenupdatingが機能せず、
ブック展開やページ移動が丸見えで、わずらわしいです。

ブックopenや他のマクロに移ると機能しないものなのですか？
それとも、コード記述に誤りがあるのでしょうか？

excel2007
「管理表.xlsmにて指定された過去データ.csvファイルを開いて、それを表示用xlsmブックに書き出し表示するマクロ」

(管理表.xlsm、表示.xlsmそれぞれに)
Thisworkbook.Open　にて「画面最大化」のマクロ

(管理表.xlsmファイルの標準モジュールに記載)
Sub 検索する()

On Error GoTo ErrorHandler

Dim bn As String
Dim sheetn As String
Dim セル1 As String
Dim セル2 As String
Dim セル3 As String
Dim 年 As String
Dim 月 As String
Dim 日 As String
Dim 検索日 As String
Dim アドレス As String
Dim nsheet As String
Dim nbook As String
Dim csheet As String
Dim cbook As String
Dim nアドレス As String
Dim fso
Dim sFile As String

bn = "管理表.xlsm"
sheetn = "検索"
セル1 = "M30"
セル2 = "Q30"
セル3 = "V30"
年 = Workbooks(bn).Sheets(sheetn).Range(セル1).Value
月 = Workbooks(bn).Sheets(sheetn).Range(セル2).Value
日 = Workbooks(bn).Sheets(sheetn).Range(セル3).Value
検索日 = (年) & (月) & (日) & (235400)
アドレス = "C:\モニターシステム\管理者用\DB\DB" & (検索日) & ".csv" 'パス変更注意
nアドレス = "C:\モニターシステム\管理者用\system\program\表示.xlsm"
cbook = "DB" & (検索日) & ".csv"
csheet = "DB" & (検索日)
nbook = "表示.xlsm"
nsheet = "手動操作"

Workbooks.Open Filename:=nアドレス, ReadOnly:=True
Workbooks(nbook).Sheets("検索中").Select

Application.ScreenUpdating = False

sFile = アドレス
Set fso = CreateObject("Scripting.FilesystemObject")

If fso.FileExists(sFile) = True Then
Workbooks.Open Filename:=アドレス

Workbooks(cbook).Sheets(csheet).Copy_After:=Workbooks(nbook).Sheets(nsheet)

Application.Run (nbook) & "!" & "データ転送"　'転送表示マクロ
Application.Run (nbook) & "!" & "シート保護"　'シート保護マクロ
UserForm4.Show (vbModeless)

Else
MsgBox "ファイルが存在しません"

End If
Exit Sub

ErrorHandler:
MsgBox "検索表示に失敗しました。入力数字を確認してください。　※一桁の数字は、必ず先頭に０を付けてください。", vbInformation, "検索失敗"
Err.Clear

End Sub

(workbook(表示.xlsm)の標準モジュールに記載)
Sub データ転送()

Dim bn As String
Dim sheetn As String
Dim セル1 As String
Dim セル2 As String
Dim セル3 As String
Dim 年 As String
Dim 月 As String
Dim 日 As String
Dim 検索日 As String
Dim csheet As String
Dim ccell As String
Dim psheet As String
Dim pcell As String
Dim pbook As String
Dim cbookad As String

bn = "管理表.xlsm" '変更注意
sheetn = "検索"
セル1 = "M30"
セル2 = "Q30"
セル3 = "V30"
年 = Workbooks(bn).Sheets(sheetn).Range(セル1).Value
月 = Workbooks(bn).Sheets(sheetn).Range(セル2).Value
日 = Workbooks(bn).Sheets(sheetn).Range(セル3).Value
検索日 = (年) & (月) & (日) & (235400)
cbook = "DB" & (検索日) & ".csv"
cbookad = "C:\モニターシステム\管理者用\DB\DB" & (検索日) & ".csv"
pbook = "表示.xlsm"
csheet = "DB" & (検索日)
ccell = "A3:P160"
psheet = "管理"
pcell = "F10:P160"

Workbooks(pbook).Activate

Application.ScreenUpdating = False

ThisWorkbook.Worksheets("管理").Visible = xlSheetVisible
Workbooks.Open Filename:=cbookad

Workbooks(cbook).Sheets(csheet).Range(ccell).Copy _ Workbooks(pbook).Sheets(psheet).Range(pcell)

Workbooks(cbook).Close savechanges:=False

Sheets("記録表").Select
Range("A1").Select
ThisWorkbook.Worksheets("管理").Visible = xlSheetHidden

UserForm14.Show　'終了ボタン

Application.ScreenUpdating = True

End Sub

汚く拙いマクロで申し訳ありませんが、
宜しくお願いします。

回答No.7

avanzato · ベストアンサー

すみません。
所用が出来き、up出来ませんでした。
CSVに対してScreenUpdatingが有効かということに関してはその答えを私は持っていません。
しかしながらCSVをWorkbooks.Openで開いてScreenUpdatingが無効になっていると言うことでしたらこちらのコードをお試しください。
'Workbooks.Open Filename:=cbookad
Open cbookad For Input As #1　'メモリ上で開く
Workbooks(pbook).Worksheets.Add '表示.xlsmにシートを追加
ActiveSheet.Name = csheet '追加されたシート名をCSVファイル名に変更
i = 0
Do Until EOF(1) 'End Of Pageまでループ
i = i + 1
Line Input #1, buf　'1行読込
'データをセルに展開する
ary = Split(buf, ",") 'カンマ区切りで格納
Range("A" & i & ":P" & i) = ary '指定範囲に展開
Loop
Close #1 'ファイルを閉じる

コードを見ていて気になったのですが
Workbooks(cbook).Sheets(csheet).Copy After:=Workbooks(pbook).Sheets("手動操作")
Workbooks(pbook).Worksheets("管理").Visible = xlSheetVisible
Workbooks(cbook).Sheets(csheet).Range(ccell).Copy Workbooks(pbook).Sheets(psheet).Range(pcell)
と言う箇所があるかと思いますがCSVから2回コピーをしています。
動作の意味が分かりませんが2回目は既にコピーしたpsheet側を使い
1回目のコピーが終わったらCSVはとした方が良いかと思いました。

回答No.6

avanzato

一通り見てみました。
簡略できるところは簡略しました。
管理表.xlsm、表示.xlsmのThisworkbook.Open内「画面最大化」は実行されないようにしてください。
とりあえず「★要変更★」部分を直して実行してください。
推測するに当初予測していたような巨大なcsvでは無いようです。
他に考えられるとしたらcsvをコピーした後にグラフが動くと思われる為、修正を行いました。
因みにコードを載せる時はファイルパス名等は伏字若しくは任意文字の方が良いです。
現状が任意なら構いませんが・・・。
任意でなければご近所でした（^^;
どちらにせよ気を付けて下さい。
（以下全て管理表の標準モジュール内）
Option Explicit
Sub 検索する()
'変数宣言
Dim bn As String
Dim sheetn As String
Dim セル1 As String
Dim セル2 As String
Dim セル3 As String
Dim 年 As String
Dim 月 As String
Dim 日 As String
Dim 検索日 As String
Dim cbookad As String
Dim cbook As String
Dim csheet As String
Dim ccell As String
Dim pbookad As String
Dim pbook As String
Dim psheet As String
Dim pcell As String
Dim fso

bn = "管理表.xlsm"
sheetn = "検索"

セル1 = "M30"
セル2 = "Q30"
セル3 = "V30"
年 = Workbooks(bn).Sheets(sheetn).Range(セル1).Value
月 = Workbooks(bn).Sheets(sheetn).Range(セル2).Value
日 = Workbooks(bn).Sheets(sheetn).Range(セル3).Value
検索日 = (年) & (月) & (日) & (235400)

ccell = "A3:P160"
csheet = "DB" & (検索日)
cbook = csheet & ".csv"
cbookad = "C:\★要変更★\" & cbook

pcell = "F10:P160"
psheet = "管理"
pbook = "表示.xlsm"
pbookad = "C:\★要変更★\" & pbook

Set fso = CreateObject("Scripting.FilesystemObject")

If fso.FileExists(cbookad) = True Then
Workbooks.Open Filename:=pbookad, ReadOnly:=True
Workbooks(pbook).Sheets("検索中").Select

Application.ScreenUpdating = False
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Workbooks.Open Filename:=cbookad

Workbooks(cbook).Sheets(csheet).Copy After:=Workbooks(pbook).Sheets("手動操作")
Workbooks(pbook).Worksheets("管理").Visible = xlSheetVisible
Workbooks(cbook).Sheets(csheet).Range(ccell).Copy Workbooks(pbook).Sheets(psheet).Range(pcell)
Workbooks(cbook).Close savechanges:=False
Sheets("記録表").Select
Range("A1").Select
ThisWorkbook.Worksheets("管理").Visible = xlSheetHidden

'Application.Run (pbook) & "!" & "シート保護"
Call シート保護
Call 全画面に変更
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True
'UserForm4.Show (vbModeless)
MsgBox ("終了")
'UserForm14.Show

Else
Application.ScreenUpdating = True
MsgBox "ファイルが存在しません"

End If
Exit Sub

ErrorHandler:
Application.ScreenUpdating = True
MsgBox "検索表示に失敗しました。入力数字を確認してください。　※一桁の数字は、必ず先頭に０を付けてください。", vbInformation, "検索失敗"
Err.Clear

End Sub

Sub シート保護()

On Error Resume Next

'Application.ScreenUpdating = False

ThisWorkbook.Worksheets("記録表").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（全体）").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫1)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫2)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫3)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫4)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫5)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("手動操作").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("検索中").Protect Password:="trytec", UserInterfaceOnly:=True
'Application.ScreenUpdating = True
End Sub

Sub 全画面に変更()
Application.DisplayFullScreen = True
End Sub

お礼

ありがとうございます。
今昼食中で戻り次第、やってみます。

伏せ字は、忘れてました。マズいですね。
消せるかしら。

私は静岡からなんですがね。

補足

やってみました。

前バージョンの方がちらつきは少ないです。
今回バージョンだとCSVからXLSMに読込むときにそれぞれ映ります。
前バージョンはCSVから最終画面にいきます。

どちらにしせよ、CSV画面がでてしまいます。

不通は開いたブック、CSVに対しても、
Application.ScreenUpdatingは効くんですか？

回答No.5

avanzato

#4の返答です。
>このcsvの展開に対して、Application.ScreenUpdatingがかからないような気がしています。
可能性はとても高いです。
と言うのもエクセルでCSVファイルを開くのは通常のファイルを開くより時間が掛ります。
もしCSVが大きいものであればそれ相応の時間が掛ります。
Workbooks.Open Filename:=アドレス
より処理の早い構文があるのでCSVが大きいときは試して見るのもいいかもしれません。
CSVのレイアウト（行・列）が分かりましたらお願いします。

お礼

コードやらなにやらが長すぎて入りきらず、
いろんな所に書いちゃいました。
見にくくてすみません。

[csvレイアウト]
予冷庫１ 予冷庫2 予冷庫3 予冷庫4 予冷庫5

温度（℃） 湿度（％） 温度（℃） 湿度（％） 温度（℃） 湿度（％） 温度（℃） 湿度（％） 温度（℃） 湿度（％）
2009/12/8 23:50 0 0 0 0 0 0 0 0 0 0
2009/12/8 22:30 0 0 0 0 0 0 0 0 0 0
2009/12/8 22:20 0 0 0 0 0 0 0 0 0 0
2009/12/8 22:10 0 0 0 0 0 0 0 0 0 0
2009/12/8 22:00 0 0 0 0 0 0 0 0 0 0
2009/12/8 21:50 0 0 0 0 0 0 0 0 0 0
2009/12/8 21:40 0 0 0 0 0 0 0 0 0 0

よくわからなかったんですが、excel.csvを冒頭部分を一部コピペしてみました。
以下、時間と数値の部分で最大160行になります。
現状(テスト状態)でフルサイズを記録していないんですが、
80行程度で、10kb弱のサイズです。(単純計算でフルで20kb程度かな)

違う拡張子を開いたらApplication.ScreenUpdatingは効かない仕様なんでしょうか？
それともコードが悪いのか。。。

仕事で必要になり、プログラムなんぞ組んだこともなく、
officeを買ってくることから初めたド素人です。

周りに聞く人もなく完全に独学でやっており、
教えてくれる事はもちろんですが、話をわかってくれる事が、なによりも泣きそうなくらいにうれしく思います。
本当にありがとうございます。

月曜に客先にもっていくので、なんとか土曜までにはしあげたいです。

補足

おはようございます。
昨日は、息子を寝かしつけてたら、一緒に寝ちゃって。。
すみません。

直してみたコードです。
Sub 検索する()

Dim bn As String
Dim sheetn As String
Dim セル1 As String
Dim セル2 As String
Dim セル3 As String
Dim 年 As String
Dim 月 As String
Dim 日 As String
Dim 検索日 As String
Dim cアドレス As String
Dim pアドレス As String
Dim pbook As String
Dim fso

bn = "予冷庫　温湿度管理表.xlsm"
sheetn = "検索"
セル1 = "M30"
セル2 = "Q30"
セル3 = "V30"
年 = Workbooks(bn).Sheets(sheetn).Range(セル1).Value
月 = Workbooks(bn).Sheets(sheetn).Range(セル2).Value
日 = Workbooks(bn).Sheets(sheetn).Range(セル3).Value
検索日 = (年) & (月) & (日) & (235400)
pbook = "表示.xlsm"
cアドレス = "C:\JAあいち知多\管理者用\DB\DB" & (検索日) & ".csv" 'パス変更注意
pアドレス = "C:\JAあいち知多\管理者用\system\program\表示.xlsm"
Set fso = CreateObject("Scripting.FilesystemObject")

If fso.FileExists(cアドレス) = True Then
Workbooks.Open Filename:=pアドレス, ReadOnly:=True
Workbooks(pbook).Sheets("検索中").Select

Application.ScreenUpdating = False

Workbooks.Open Filename:=cアドレス
Call 表からデータ転送

Else
MsgBox "ファイルが存在しません"

End If
Exit Sub

ErrorHandler:
MsgBox "検索表示に失敗しました。入力数字を確認してください。　※一桁の数字は、必ず先頭に０を付けてください。", vbInformation, "検索失敗"
Err.Clear

End Sub

Sub 表からデータ転送()

Application.ScreenUpdating = False

Dim bn As String
Dim sheetn As String
Dim セル1 As String
Dim セル2 As String
Dim セル3 As String
Dim 年 As String
Dim 月 As String
Dim 日 As String
Dim 検索日 As String
Dim csheet As String
Dim ccell As String
Dim psheet As String
Dim pcell As String
Dim pbook As String
Dim cbookad As String

bn = "予冷庫　温湿度管理表.xlsm" '変更注意
sheetn = "検索"
セル1 = "M30"
セル2 = "Q30"
セル3 = "V30"
年 = Workbooks(bn).Sheets(sheetn).Range(セル1).Value
月 = Workbooks(bn).Sheets(sheetn).Range(セル2).Value
日 = Workbooks(bn).Sheets(sheetn).Range(セル3).Value
検索日 = (年) & (月) & (日) & (235400)
cbook = "DB" & (検索日) & ".csv"
cbookad = "C:\JAあいち知多\管理者用\DB\DB" & (検索日) & ".csv"
pbook = "表示.xlsm"
csheet = "DB" & (検索日)
ccell = "A3:P160"
psheet = "管理"
pcell = "F10:P160"

Workbooks(cbook).Sheets(csheet).Copy After:=Workbooks(pbook).Sheets("手動操作")
Workbooks(pbook).Worksheets("管理").Visible = xlSheetVisible
Workbooks(cbook).Sheets(csheet).Range(ccell).Copy Workbooks(pbook).Sheets(psheet).Range(pcell)
Workbooks(cbook).Close savechanges:=False
Sheets("記録表").Select
Range("A1").Select
ThisWorkbook.Worksheets("管理").Visible = xlSheetHidden

Application.Run (pbook) & "!" & "シート保護"

UserForm4.Show (vbModeless)
UserForm14.Show

Application.ScreenUpdating = True

End Sub

回答No.4

avanzato

コメント化='を付けるでokです。
紛らわしくてすみません。
当方でも同じような環境を作ってテストしてみました。
若干宣言の無い変数はございましたが動作を確認できました。
本件とは関係無いかも知れませんが、現在データ転送ルーチンを表示.XLSMにおいてApplication.Run (nbook) & "!" & "データ転送で呼び出されておりますが管理表.xlsmの標準モジュールに配置してCall データ転送で呼び出した方が良いと思います。
メンテナンスも楽ですし・・・。
もしデータ転送ルーチンに組み込めるなら組み込んで再コーディングしてください。
処理速度と無駄なメモリー使用が無くなります。
また、UserForm14がどのようなものかは分かりませんが終了メッセージだけと言うことでしたらMSGBOX("終了")の方が便利ですし処理速度が向上します。
因みに最大化とシート保護のソースがありませんがこちらの問題はありませんでしょうか？
↑上記2つの処理を飛ばして処理して正常な動作確認が行えた為

お礼

Sub シート保護()

On Error Resume Next

Application.ScreenUpdating = False

ThisWorkbook.Worksheets("記録表").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（全体）").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫1)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫2)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫3)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫4)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("グラフ（予冷庫5)").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("手動操作").Protect Password:="trytec", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("検索中").Protect Password:="trytec", UserInterfaceOnly:=True

Application.ScreenUpdating = True

End Sub

Sub 全画面に変更()

Application.ScreenUpdating = False
Application.DisplayFullScreen = True

End Sub

補足

ありがとうございます。出先で携帯しか使えないので、
直したコードは夜に上げます。

最大化、シート保護は他でも使用しており、そこでは、効いております。
Userformは、注意事項の表示（14）と、ボタンを押して表示.xlsmを終了させる（4）、の２つです。

手直しをしたところ、開いたcsvファイルが表示されるところまで漕ぎ着けました。
（それまでは他にもあったのですが）

"検索中"という画面が出たあと、csvファイルが全開になり（2、3秒）、検索ファイル表示画面になります。

この流れは正しいと思いますが。。

csvをOpen以下をデータ転送にまとめ、同ファイルのモジュールにしました。
そちらの画面更新はしませんでした。

ので、このcsvの展開に対して、Application.ScreenUpdatingがかからないような気がしています。

なんかの糸口になりますかね？

回答No.3

avanzato

連登すみません。
イミディエイトウィンドウはウインドウ内に直接打つ使用ではなくプロシージャ内に入れて実行します。
例）
Sub デバッグテスト()
　Debug.Print "Step1まで進みました。："&Application.ScreenUpdating
　Debug.Print "Step2まで進みました。："&Application.ScreenUpdating
End Sub
どこまで処理が進んで状況がどうか見れます。

お礼

度々の回答ありがとうございます。

コメント化がよくわかりませんが、Application.ScreenUpdating=Falseを
'Application.ScreenUpdating=Felseに、
同様に'～=Trueに変更し
実行かけましたが、変化なしです。

Debug.Print Application.ScreenUpdating（=Felseは抜きました）にして（～=Trueはそのままですが）、実行したら、
イミディエイトウィンドウに
True
とでました。

Debug.Printした所がTrueって事でしょうか？

回答No.2

avanzato

再度見直しをしました。
ちょっと試して欲しいことがあります。
データ転送ルーチン内のScreenUpdating（False,True両方）をコメント化して実行しないようにしてください。
検索ルーチン内のApplication.ScreenUpdating = Falseは元もとの場所でOKです。
Exit SubとEnd Subの前の行にApplication.ScreenUpdating = Trueを入れてください。

検索ルーチン内でデータ転送ルーチンが動いていますので都度ScreenUpdatingを切り替える必要はありません。
例）
メインルーチン
　Application.ScreenUpdating = False
　サブルーチン１
　サブルーチン２
　Application.ScreenUpdating = True
End

回答No.1

avanzato

こんにちは。
さらっと見ましたがApplication.ScreenUpdating = Falseにしている位置がWorkbooks.Openより後に来ています。
ワークブックを開いた後に画面更新OFFになっているのが原因かと思います。
私がScreenUpdatingを使用するときはFalseはプロシージャの先頭
sub ～の後の行です。
逆にTrueはEnd Subの前、ラベルで分岐がある場合はEnd SubとExit Subの前の行にそれぞれ入れています。
ScreenUpdatingの状態を確認するときはイミディエイト画面を開き
状態を確認したい位置に
Debug.Print Application.ScreenUpdating
を入れることで機能しているかが確認できます。

お礼

携帯から失礼します。
ありがとうございます。
Openした後に入れたのは、"処理中"と書かれた画面を見せる為でした。

しかし、先頭にScreenUpdatingを入れても変化はありません。

イミディエイトウィンドウにDebug.Print Application.ScreenUpdatingと入力してEnterを押すと、下段にTrueとなりますが。。

このイミディエイトウィンドウがよくわからなくて、どうなのかわかりませんが、報告まで。