ステータスバーに「処理中 **/**件」表示
フォルダ内に複数あるCSVファイルを一つのエクセルにまとめるマクロを検討中で
ホームページで自分が作成したいマクロに似ていたものがあったので流用して考えいます。
やりたい事:
フォルダ内のファイル件数をカウントしステータスバーに
「処理中 **/**件」 と全体のどれだけ処理が進んでいるか表示をしたいです
完了したら「処理 完了」に変更したいです
分からない事:
一番下の辺にある
MsgBox "ファイル数は" & fc & "件です。"
の中のfcが全ファイル件数が表示されるんですが
そのfcを使用して
初めの方にある
Application.StatusBar = "処理実行中 " & cntRec & "/" & fc & "件"
の中のfcにカウントした数字が表示されません
表示する方法を教えてください
Private Functionが何かあるとは思っていますが、理解できなくて・・・
'---------------------------------------------------------------------
Sub 集計マクロ()
色々処理している・・・
cntRec = cntRec + 1
Application.StatusBar = "処理実行中 " & cntRec & "/" & fc & "件"
End Sub
'---------------------------------------------------------------------
Private Function CSVQRY(ByRef ws As Worksheet, _ 'csvからデータ読み出し?
ByRef fs As String, _
ByRef rs As Range, _
ByVal sr As Long) As Long
Dim cnt As Long
On Error GoTo errChk
With ws.QueryTables.Add(Connection:="TEXT;" & fs, _
Destination:=rs)
.AdjustColumnWidth = False
.TextFilePlatform = xlWindows
.TextFileStartRow = sr
.TextFileCommaDelimiter = True
.Refresh False
cnt = .ResultRange.Rows.Count
.Parent.Names(.Name).Delete
.Delete
End With
CSVQRY = cnt
Exit Function
errChk:
CSVQRY = -1
End Function
'---------------------------------------------------------------------
Private Function FDSELECT() As String 'フォルダ選択Function
Dim obj As Object
Dim ret As String
Set obj = CreateObject("Shell.Application") _
.BrowseForFolder(0, "SelectFolder", 0)
If obj Is Nothing Then Exit Function
On Error Resume Next
ret = obj.self.Path & "\"
If Err.Number <> 0 Then
ret = obj.Items.Item.Path & "\"
Err.Clear
End If
On Error GoTo 0
Set obj = Nothing
FDSELECT = ret
' 指定フォルダ内のcsv数をメッセージBoxに表示
Dim fc As Long 'ファイル数
Dim fm As String 'ファイル名
fm = Dir(ret & "\*.csv", vbNormal)
Do While fm <> ""
fc = fc + 1
fm = Dir()
Loop
MsgBox "ファイル数は" & fc & "件です。"
End Function
お礼
ありがとうございます。 紹介いただいている事例と一緒でした。 ScreenUpdatingをFalseにすると発生するみたいです。いつもFalseにしていますが、Trueでしてみたら再現しませんでした。ただ、ちらつき防止でTrueにはしたくないもので困りました。 仕様みたいですね。 Officeは365です。 いろいろ書き忘れていますが、Excelです。