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

Question

お願いします。
長文失礼します。

下記マクロを実行しても、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


汚く拙いマクロで申し訳ありませんが、
宜しくお願いします。

avanzato · Accepted Answer

すみません。
所用が出来き、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はとした方が良いかと思いました。

avanzato · Answer

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

avanzato · Answer

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

avanzato · Answer

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

avanzato · Answer

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

avanzato · Answer

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

avanzato · Answer

一通り見てみました。
簡略できるところは簡略しました。
管理表.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

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

こんにちは。

再度見直しをしました。

連登すみません。

コメント化='を付けるでokです。

この回答への補足

#4の返答です。

この回答への補足

一通り見てみました。

この回答への補足

すみません。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング