[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームのプログレスバーで進捗を見たい』（実装野郎）
おはようございます。
再度お世話になります。
処理中の進捗をユーザーフォームのプログレスバーで見るvbaを教えて頂きたいです。
現在のコードは処理中の間だけユーザーフォームが表示され、処理が
終わったら次のユーザーフォームへ移動という内容です。
Private Sub UserForm_Activate()
Dim TotalSize As Long, buf As String
UserForm42.Repaint
Worksheets("一時保管").Range("G46").ClearContents
Worksheets("一時保管").Range("J46").ClearContents
Range("K2", "R10000").ClearContents
Range("X2", "X200").ClearContents
Application.ScreenUpdating = False
Dim myRange As Range, meRange As Range, myAddress As String, i As Integer
Set meRange = Sheets("原本").Range("A1:N20000")
Set myRange = meRange.Find(What:=Sheets("yyyy").Range("B23").Value, LookAt:=xlWhole)
If Not myRange Is Nothing Then
myAddress = myRange.Address
これ以降は同じような処理のコードが続きますので割愛
buf = Dir("C:/Windows/System32/*.*")
Do While buf <> ""
TotalSize = TotalSize + FileLen("C:/Windows/System32/" & buf)
buf = Dir()
Loop
Unload Me
UserForm30.Show
End If
が現状です。
これをユーザーフォームを開きその中のプログレスバーで実際のパーセント表示で進捗を見るにはどうしたらよいでしょうか？
説明が下手で申し訳ございませんがお願い致します。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
"VBA プログレスバーの使い方" で検索してヒットする
https://www.sejuku.net/blog/72730
などを参考にして真似してみてください。
# status barで十分ではないですか？（私見)
（γ） 2022/05/11(水) 07:48
（実装野郎） 2022/05/11(水) 08:08
横から失礼します。
γさんご紹介のFSOはﾌｫﾙﾀﾞやﾌｧｲﾙのサイズも取得できます。 処理する全体のサイズを集計し、どれくらいｺﾋﾟｰしたかをプログレスバー には寧してはいかがでしょう？ 頑張ってください。 （OK） 2022/05/11(水) 08:19
>どれくらいｺﾋﾟｰしたかをプログレスバーには寧してはいかがでしょう？
↓の間違いでした。
>どれくらいｺﾋﾟｰしたかをプログレスバーに反映してはいかがでしょう？ （OK） 2022/05/11(水) 08:21
＞選択する物によってコピーする数が違うので処理時間が違います。
なにか、進捗度というものを勘違いしている気配ですが、頑張ってください。
（γ） 2022/05/11(水) 09:25
>＞気分を悪くさせてすみませんでした。 >この文言ある特定の回答者に対してよく聞くセリフだな。
「気分を悪く」で過去ログ検索してみたが、このスレの回答者 が回答したスレはヒットしなかった。
このスレの回答者に向けたコメントではないとしたら、なぜ このスレに書き込んだのか意味不明だ。 （OK） 2022/05/11(水) 10:32
何の選択かは分かりませんが、
選別したファイルパスを一旦、DictionaryやCollection、配列などに代入し、
カウント出来るようにしておきます。
その後、Forループでブログレスバーでパーセントでも見せればいいかと。
（tkit） 2022/05/11(水) 10:43
むかし何かに血迷って作ったクラスを発掘したのです。 (プログレスバーコントロール使わずに何やら行うつもりで色々血迷ったものと推測)
結局本題とはあんま関係ないかも知れませんが... ジョークのひとつだと思って下さい。
▼[clsProgressElements](クラスモジュール)
Option Explicit
#If False Then 'IDEにEnum定数名の大文字・小文字を認識させる為の対処
Private peShuttleNormal
Private peShuttleSwing
Private peShuttleRetarded
#End If
Private Type apiCursorPos
X As Long
Y As Long
End Type
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const DefaultMax As Long = 100
#If VBA7 Then
Private Declare PtrSafe Function GetCursorPos Lib "User32" (lpPoint As apiCursorPos) As Long
Private Declare PtrSafe Function ScreenToClient Lib "User32" (ByVal hWnd As LongPtr, lpPoint As apiCursorPos) As Long
Private Declare PtrSafe Function GetFocus Lib "User32" () As LongPtr
Private Declare PtrSafe Function GetDC Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
'Private Declare PtrSafe Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
'Private Declare PtrSafe Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
#Else
Private Declare Function GetCursorPos Lib "User32" (lpPoint As apiCursorPos) As Long
Private Declare Function ScreenToClient Lib "User32" (ByVal hWnd As Long, lpPoint As apiCursorPos) As Long
Private Declare Function GetFocus Lib "User32" () As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
'Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
'Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
#End If
Private pValue As Long, pMax As Long, pMin As Long
Private pBarObject As Object, pVertical As Boolean, pFlip As Boolean, pReverse As Boolean
Private pWidthDef As Single, pLeftDef As Single, pTopDef As Single, pHeightDef As Single
Private pPeriod As Long, pResetedMs As Double
Public Enum peShuttleMode
peShuttleNormal = 0
peShuttleSwing = 1
peShuttleRetarded = 2
End Enum
Rem イベント############################################################################################################
Public Event Change(ByVal OldValue As Long) '現在値が変わった時(OldValueは変わる前のValue)
Public Event BeforeBarUpdate(ByRef Cancel As Boolean) 'バーの更新前(CancelにTrueが入ると更新をやめる)
Public Event AfterBarUpdate() 'バーの更新後
Public Event Maximized() '最大値に達した時
Public Event Minimized() '最小値に達した時
Public Event ValueUp(ByVal OldValue As Long) '現在値が増加した時(OldValueは変わる前のValue)
Public Event ValueDown(ByVal OldValue As Long) '現在値が減少した時(OldValueは変わる前のValue)
Rem プロパティ##########################################################################################################
Rem 最大値--------------------------------------------------------------------------------------------------------------
Public Property Get Max() As Long
Max = pMax
End Property
Public Property Let Max(NewMax As Long)
If NewMax < pMin Then Err.Raise 380 'プロパティの値が不正です。
If NewMax = pMax Then Exit Property
pMax = NewMax
If pValue > pMax Then Value = pMax
Call TimeReset
Call UpdateBar
End Property
Rem 最少値--------------------------------------------------------------------------------------------------------------
Public Property Get Min() As Long
Min = pMin
End Property
Public Property Let Min(newMin As Long)
If newMin > pMax Then Err.Raise 380 'プロパティの値が不正です。
If newMin = pMin Then Exit Property
pMin = newMin
If pValue < pMin Then Value = pMin
Call TimeReset
Call UpdateBar
End Property
Rem 現在値--------------------------------------------------------------------------------------------------------------
Public Property Get Value() As Long
Value = pValue
End Property
Public Property Let Value(NewValue As Long)
If NewValue = pValue Then Exit Property
Static Lap As Double
Dim Flg As Boolean, tmp As Long, tmpMs As Double
tmp = pValue
pValue = NewValue
RaiseEvent Change(tmp) 'イベント
If pValue > tmp Then RaiseEvent ValueUp(tmp) 'イベント
If pValue < tmp Then RaiseEvent ValueDown(tmp) 'イベント
If pValue = pMax Then RaiseEvent Maximized 'イベント
If pValue = pMin Then RaiseEvent Minimized 'イベント
tmpMs = UpTimeMs
If (tmpMs - Lap >= UpdatePeriod) Then
Lap = tmpMs
Flg = True
End If
If Not Flg Then Flg = (pValue = pMax)
If Not Flg Then Flg = Flg Or (pValue = pMin)
If Flg Then Call UpdateBar
End Property
Rem パーセント----------------------------------------------------------------------------------------------------------
Rem 現在の値をパーセントで表した値(マイナス、100%超もそのまま表現)
Public Property Get per() As Single
If pMax - pMin = 0 Then Exit Property
per = (pValue - pMin) / (pMax - pMin)
End Property
Rem バーの幅を-100%〜100%の間で表した値(※Reverseプロパティの設定には影響されない)
Public Property Get PerW() As Single
If pMax - pMin = 0 Then Exit Property
Dim Res As Single
Res = (pValue - pMin) / (pMax - pMin)
If Res = 0 Then Exit Property
If Res < 0 Then
PerW = (Res - Int(Res)) - 1
Else
PerW = 1 - (-Res - Int(-Res))
End If
End Property
Rem バーのカーソル位置を0%〜100%の間で表した値(※Flipプロパティ、Reverseプロパティによる影響を受ける)
Rem 例えばこのクラスの様にバーの伸縮で表現するんじゃなく、バーの移動で表現したりする時に使う
Public Property Get PerP() As Single
PerP = PerW
If pReverse Then
If PerP <= 0 Then
PerP = PerP + 1
Else
PerP = PerP - 1
End If
End If
If pFlip Then PerP = 1 - PerP
If PerP < 0 Then PerP = PerP + 1
If PerP > 1 Then PerP = PerP - 1
End Property
Rem 最後にResetまたはTimeResetを実行してからの経過ミリ秒----------------------------------------------------------------
Public Property Get Elapsed() As Double
Elapsed = (UpTimeMs - pResetedMs)
End Property
Rem バー(オブジェクト)--------------------------------------------------------------------------------------------------
Rem オブジェクト(コントロールや描画オブジェクト等)そのもの
Public Property Get Bar() As Object
Set Bar = pBarObject
End Property
Public Property Set Bar(aBar As Object)
If pBarObject Is aBar Then Exit Property
Call SetBar(aBar)
End Property
Rem オブジェクトの水平座標
Public Property Get DefaultLeft() As Single
DefaultLeft = pLeftDef
End Property
Public Property Let DefaultLeft(newLeft As Single)
If pLeftDef = newLeft Then Exit Property
pLeftDef = newLeft
Call UpdateBar
End Property
Rem 100%時のオブジェクト幅
Public Property Get DefaultWidth() As Single
DefaultWidth = pWidthDef
End Property
Public Property Let DefaultWidth(newWidth As Single)
If newWidth < 0 Then Err.Raise 380 'プロパティの値が不正です。
If pWidthDef = newWidth Then Exit Property
pWidthDef = newWidth
Call UpdateBar
End Property
Rem オブジェクトの垂直座標
Public Property Get DefaultTop() As Single
DefaultTop = pTopDef
End Property
Public Property Let DefaultTop(newTop As Single)
If pTopDef = newTop Then Exit Property
pTopDef = newTop
Call UpdateBar
End Property
Rem 100%時のオブジェクト高
Public Property Get DefaultHeight() As Single
DefaultHeight = pHeightDef
End Property
Public Property Let DefaultHeight(newHeight As Single)
If newHeight < 0 Then Err.Raise 380 'プロパティの値が不正です。
If pHeightDef = newHeight Then Exit Property
pHeightDef = newHeight
Call UpdateBar
End Property
Rem その他バーの表現に関する設定値--------------------------------------------------------------------------------------
Rem 縦グラフにする(普通は右に伸びるのを、Trueで上に伸ばす)
Public Property Get Vertical() As Boolean
Vertical = pVertical
End Property
Public Property Let Vertical(newOrientation As Boolean)
If pVertical = newOrientation Then Exit Property
pVertical = newOrientation
Call UpdateBar
End Property
Rem バーの向きを反転する(普通は右か上に伸びるのを、Trueで左か下に伸ばす)
Public Property Get Flip() As Boolean
Flip = pFlip
End Property
Public Property Let Flip(newFlip As Boolean)
If pFlip = newFlip Then Exit Property
pFlip = newFlip
Call UpdateBar
End Property
Rem バーの伸縮を反転(100%で幅ゼロ、0%で最大幅になる)
Rem 例えば固定幅のバー画像の上にマスクバーを重ねて、マスクバーの伸縮によって表現する時なんかに使う
Public Property Get Reverse() As Boolean
Reverse = pReverse
End Property
Public Property Let Reverse(newReverse As Boolean)
If pReverse = newReverse Then Exit Property
pReverse = newReverse
Call UpdateBar
End Property
Rem バー描画更新の更新周期を設定する(BarUpdateイベントの発生頻度を制御する)
Rem 補足:Changeイベントはバーの有無に関わらずValueが変わると発生するので、このプロパティとは関係ない
Public Property Get UpdatePeriod() As Long
UpdatePeriod = pPeriod
End Property
Public Property Let UpdatePeriod(NewPeriod As Long)
If NewPeriod < 0 Then Err.Raise 380 'プロパティの値が不正です。
If pPeriod = NewPeriod Then Exit Property
pPeriod = NewPeriod
End Property
Rem メソッド############################################################################################################
Rem 最大値・最小値を一括設定(現在値は最小値と同じ値に置き換わる)--------------------------------------------------------
Public Sub Reset(Optional ByVal NewMax As Long = DefaultMax, Optional ByVal newMin As Long = 0)
Me.Max = NewMax
Me.Min = newMin
Me.Value = Me.Min
End Sub
Rem 現在の値に加算する(引数省略時は1インクリメント)---------------------------------------------------------------------
Public Sub Add(Optional aValue As Long = 1)
Value = pValue + aValue
End Sub
Rem 経過ミリ秒をリセット(MaxまたはMinの変更およびResetメソッドの呼び出し時には自動的に実行される)-----------------------
Public Sub TimeReset()
pResetedMs = UpTimeMs
End Sub
Rem プログレスバーに見立てるコントロールを設定する----------------------------------------------------------------------
Rem VerticalBar --- 垂直グラフにする(省略時は水平バー)
Rem BarFlip ------- グラフの向きを反転(省略時は右又は上に伸びる)
Rem BarReverse ---- グラフの伸縮を反転(省略時は100%に向かって伸びる)
Rem BarLeft,BarWidth,BarTop,BarHeight --- 元(100%時)のコントロールの座標・サイズを設定する
Rem (省略時は引数aBarの座標・サイズをそのまま流用する。つまり呼び出し時にaBarが100%時の形をしていれば省略可)
Public Sub SetBar(aBar As Object _
, Optional ByVal VerticalBar As Boolean = False, Optional ByVal BarFlip As Boolean = False _
, Optional ByVal BarReverse As Boolean = False _
, Optional ByVal BarLeft As Single, Optional ByVal BarWidth As Single _
, Optional ByVal BarTop As Single, Optional ByVal BarHeight As Single _
)
Set pBarObject = aBar
If Not pBarObject Is Nothing Then
If BarLeft = Empty Then BarLeft = pBarObject.Left
If BarWidth = Empty Then BarWidth = pBarObject.Width
If BarTop = Empty Then BarTop = pBarObject.Top
If BarHeight = Empty Then BarHeight = pBarObject.Height
End If
pLeftDef = BarLeft
pWidthDef = BarWidth
pTopDef = BarTop
pHeightDef = BarHeight
pVertical = VerticalBar
pFlip = BarFlip
pReverse = BarReverse
Call UpdateBar
End Sub
Rem バーの表示を現在の値の状態に更新する--------------------------------------------------------------------------------
Public Sub UpdateBar()
If pBarObject Is Nothing Then Exit Sub
Dim p As Single, Flg As Boolean
RaiseEvent BeforeBarUpdate(Flg) 'イベント
If Flg Then Exit Sub
p = PerW
If pReverse Then
If p <= 0 Then
p = p + 1
Else
p = p - 1
End If
End If
If pFlip Then p = -p
With pBarObject
If pVertical Then
.Left = pLeftDef
.Width = pWidthDef
If p < 0 Then
.Top = pTopDef
Else
.Top = pTopDef + pHeightDef - pHeightDef * Abs(p)
End If
.Height = pHeightDef * Abs(p)
Else
.Top = pTopDef
.Height = pHeightDef
If p < 0 Then
.Left = pLeftDef + pWidthDef - pWidthDef * Abs(p)
Else
.Left = pLeftDef
End If
.Width = pWidthDef * Abs(p)
End If
End With
DoEvents
RaiseEvent AfterBarUpdate 'イベント
End Sub
Rem 呼び出す度にバーをマーキーモードで動かす----------------------------------------------------------------------------
Rem ３分の１幅のバーが通り過ぎていくモード
Rem Stepはバーが自幅分の移動に必要な移動回数(Step×４回呼び出したら一周(10回未満は10回とみなす))
Public Sub Marquee(Optional ByVal Step As Long = 10)
Static sMqCount As Long
Dim c As Long, p As Single, s As Single
If Step < 10 Then Step = 10
sMqCount = (sMqCount + 1) Mod (Step * 4)
If pBarObject Is Nothing Then Exit Sub
c = sMqCount
If pVertical Xor pFlip Then c = (Step * 4) - c 'どちらか一方がTrueだったら反転
With pBarObject
If pVertical Then
.Left = pLeftDef
.Width = pWidthDef
s = pHeightDef * 1 / 3
Select Case c
Case Is > Step * 3: s = s * (c - Step * 3) / Step
Case Is > Step * 2: s = s * (Step * 3 - c) / Step
End Select
p = pTopDef
If c <= (Step * 3) Then p = pTopDef + pHeightDef * c / (Step * 3)
.Top = p
.Height = s
Else
.Top = pTopDef
.Height = pHeightDef
s = pWidthDef * 1 / 3
Select Case c
Case Is > Step * 3: s = s * (c - Step * 3) / Step
Case Is > Step * 2: s = s * (Step * 3 - c) / Step
End Select
p = pLeftDef
If c <= (Step * 3) Then p = pLeftDef + pWidthDef * c / (Step * 3)
.Left = p
.Width = s
End If
End With
DoEvents
End Sub
Rem ３分の１幅のバーが行ったり来たりするモード
Rem Stepはバーが反対側までの移動に必要とする移動回数(10回未満は10回とみなす)
Rem ModeにpeShuttleSwingを指定するとバーの移動速度が振り子運動っぽく変動する
Rem ModeにpeShuttleRetardedを指定するとバーの移動速度が減速運動っぽく変動する
Public Sub Shuttle(Optional ByVal Step As Long = 10, Optional ByVal Mode As peShuttleMode = peShuttleNormal)
Static sMqCount As Long
Dim v As Double, p As Single
If Step < 10 Then Step = 10
sMqCount = (sMqCount + 1) Mod (Step * 2)
If pBarObject Is Nothing Then Exit Sub
Select Case Abs(Mode)
Case peShuttleSwing
v = 360 / (Step * 2) * sMqCount
v = v - Int(v / 360) * 360
p = (1 - Cos(Rad(v))) / 2 'Evaluate("(1-COS(RADIANS(" & v & ")))/2")
Case peShuttleRetarded
v = Step - (sMqCount - Int(sMqCount / Step) * Step)
p = v ^ 2 / Step ^ 2
If sMqCount < Step Then p = 1 - p
Case Else
v = sMqCount - Int(sMqCount / (Step * 2)) * (Step * 2)
If v > Step Then v = (Step * 2) - v
p = v / Step
End Select
If pVertical Xor pFlip Then p = 1 - p 'どちらか一方がTrueだったら反転
With pBarObject
If pVertical Then
.Left = pLeftDef
.Width = pWidthDef
.Height = pHeightDef * 1 / 3
.Top = pTopDef + pHeightDef * 2 / 3 * p
Else
.Top = pTopDef
.Height = pHeightDef
.Width = pWidthDef * 1 / 3
.Left = pLeftDef + pWidthDef * 2 / 3 * p
End If
End With
DoEvents
End Sub
Rem マウスカーソルの現座標を元に現在値を取得----------------------------------------------------------------------------
Rem Marginはバーの内側に想定する余白部分(バーのLeft+Marginを0%位置、バーのLeft+Width-Marginを100%位置と想定する)
Public Function GetValueOnCurX(Optional Margin As Single) As Single
Dim p As Single
p = GetPosX(Margin) - pLeftDef - Margin
p = p / (pWidthDef - Margin * 2)
If pFlip Then p = 1 - p
GetValueOnCurX = (pMax - pMin) * p
End Function
Rem Marginはバーの内側に想定する余白部分(バーのTop+Height-Marginを0%位置、バーのTop+Marginを100%位置と想定する)
Public Function GetValueOnCurY(Optional Margin As Single) As Single
Dim p As Single
p = GetPosY(Margin) - pTopDef - Margin
p = 1 - p / (pHeightDef - Margin * 2)
If pFlip Then p = 1 - p
GetValueOnCurY = (pMax - pMin) * p
End Function
Rem 現在の設定状況下においてValueプロパティがtestValueだと仮定した場合のPerP値を試算------------------------------------
Public Function TestPerP(ByVal testValue As Long) As Single
If pMax - pMin = 0 Then Exit Function
Dim Res As Single
Res = (testValue - pMin) / (pMax - pMin)
If Res = 0 Then Exit Function
If Res < 0 Then
Res = (Res - Int(Res)) - 1
Else
Res = 1 - (-Res - Int(-Res))
End If
If pReverse Then
If Res <= 0 Then
Res = Res + 1
Else
Res = Res - 1
End If
End If
If pFlip Then Res = 1 - Res
If Res < 0 Then Res = Res + 1
If Res > 1 Then Res = Res - 1
TestPerP = Res
End Function
Rem 以下内部処理########################################################################################################
Rem DPI取得関数
Private Function GetDPI(nIndex As Long) As Long
Dim hdc As Long
hdc = GetDC(Application.hWnd)
GetDPI = GetDeviceCaps(hdc, nIndex)
ReleaseDC &H0, hdc
End Function
Rem 水平DPI取得
Private Property Get DPIx() As Long
DPIx = GetDPI(LOGPIXELSX)
End Property
Rem 垂直DPI取得
Private Property Get DPIy() As Long
DPIy = GetDPI(LOGPIXELSY)
End Property
Rem PPI取得
Private Property Get PPI() As Long
PPI = Application.InchesToPoints(1)
End Property
Rem π取得
Private Property Get PI() As Double
PI = Atn(1) * 4
End Property
Rem 度をラジアンに変換する関数
Private Function Rad(aDeg As Double) As Double
Rad = PI / 180 * aDeg
End Function
Rem マウスカーソルの現水平座標
Private Function GetPosX(Optional Margin As Single) As Single
Dim Pos As apiCursorPos
Dim p As Single
Call GetCursorPos(Pos)
Call ScreenToClient(GetFocus, Pos)
GetPosX = (Pos.X * PPI / DPIx)
If GetPosX < pLeftDef + Margin Then GetPosX = pLeftDef + Margin
If GetPosX > (pLeftDef + pWidthDef - Margin) Then GetPosX = (pLeftDef + pWidthDef - Margin)
End Function
Rem マウスカーソルの現垂直座標
Private Function GetPosY(Optional Margin As Single) As Single
Dim Pos As apiCursorPos
Dim p As Single
Call GetCursorPos(Pos)
Call ScreenToClient(GetFocus, Pos)
GetPosY = (Pos.Y * PPI / DPIy)
If GetPosY > (pTopDef + pHeightDef - Margin) Then GetPosY = (pTopDef + pHeightDef - Margin)
If GetPosY < pTopDef + Margin Then GetPosY = pTopDef + Margin
End Function
Rem 符号なし長整数型変換したtimeGetTimeを返す関数
Private Property Get UpTimeMs() As Double
Dim U As Long
U = timeGetTime()
If U < 0 Then UpTimeMs = U + (&H80000000 * -2#) Else UpTimeMs = U
End Property
Rem コンストラクタ・デストラクタ----------------------------------------------------------------------------------------
Private Sub Class_Initialize()
Me.Max = DefaultMax
' Call timeBeginPeriod(1)
End Sub
Private Sub Class_Terminate()
Set pBarObject = Nothing
' Call timeEndPeriod(1)
End Sub
▼[UserForm1](UserFormモジュール) デモ(動作確認)用
Option Explicit
Private Frame1 As MSForms.Frame
Private WithEvents LabelCap As MSForms.Label 'バーの真ん中でパーセント表示するラベル
Private WithEvents LabelCap2 As MSForms.Label 'バーの伸縮に連動して移動しながらパーセント表示するラベル
Private LabelBar As MSForms.Label '前面のバー(1%刻み伸縮。反転ボタン対応)
Private LabelBar2 As MSForms.Label '背面のバー(10%刻み伸縮)
Private WithEvents Spin1 As MSForms.SpinButton
Private WithEvents TglBtnFlip As MSForms.ToggleButton 'バーの向き反転ボタン
Private WithEvents TglBtnRev As MSForms.ToggleButton 'バーの伸縮反転ボタン
Private WithEvents PEO As clsProgressElements '前面のバーに対応させるクラス
Private PEO2 As clsProgressElements '背面のバーに対応させるクラス
Private Frame2 As MSForms.Frame
Private LabelBarV As MSForms.Label
Private LabelMqe As MSForms.Label 'マーキーのバー
Private LabelStl1 As MSForms.Label 'シャトル(1:定速)のバー
Private LabelStl2 As MSForms.Label 'シャトル(2:振子)のバー
Private LabelStl3 As MSForms.Label 'シャトル(3:減速)のバー
Private PEOv As clsProgressElements
Private PEOm As clsProgressElements 'マーキーのバーに対応させるクラス
Private PEOs1 As clsProgressElements 'シャトル(1:定速)のバーに対応させるクラス
Private PEOs2 As clsProgressElements 'シャトル(2:振子)のバーに対応させるクラス
Private PEOs3 As clsProgressElements 'シャトル(3:減速)のバーに対応させるクラス
Private LabelCap3 As MSForms.Label '経過秒
Rem バーの描画領域内でマウスボタンを押すと、マウス位置が示すパーセント値をフォームのキャプションに表示
Private Sub LabelCap_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Dim p As Single, v As Long
v = PEO.GetValueOnCurX()
p = PEO.TestPerP(v)
Me.Caption = v & " (" & Format$(p, "0.0%") & ")"
End If
End Sub
Rem 移動するパーセント表示ラベルをマウスで動かす(擬似的なスライダーコントロール)
Private Sub LabelCap2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Dim p As Single, v As Long
v = PEO.GetValueOnCurX(LabelCap2.Width / 2)
Spin1.Value = Round(v / 5) * 5 '5%刻みで再設定
End If
End Sub
Rem バーが更新されたら移動するパーセント表示ラベルも移動
Private Sub PEO_AfterBarUpdate()
Dim p As Single
p = PEO.DefaultWidth * PEO.PerP
p = p - LabelCap2.Width / 2
If p < 0 Then p = 0
If p > PEO.DefaultWidth - LabelCap2.Width Then p = PEO.DefaultWidth - LabelCap2.Width
LabelCap2.Left = p
End Sub
Rem クラスの値が代わったらパーセント表示ラベルのパーセント表示も書き換え
Private Sub PEO_Change(ByVal OldValue As Long)
LabelCap.Caption = Format$(PEO.per, "0%")
LabelCap2.Caption = Format$(PEO.Value, "#,##0")
End Sub
Rem スピンボタンの値が変わったらクラスの値に代入(及びマーキーとシャトルの更新)
Private Sub Spin1_Change()
PEO.Value = Spin1.Value
PEO2.Value = -Int(-Abs(Spin1.Value) / 10) * 10 * Sgn(Spin1.Value)
PEOv.Value = Spin1.Value
PEOm.Marquee 30
PEOs1.Shuttle 30
PEOs2.Shuttle 30, peShuttleSwing
PEOs3.Shuttle 30, peShuttleRetarded
LabelCap3.Caption = Format$(PEOv.Elapsed / 1000, "#,##0.00sec")
End Sub
Rem バーの向き反転をクラスに伝える
Private Sub TglBtnFlip_Change()
PEO.Flip = TglBtnFlip.Value
End Sub
Rem バーの伸縮反転をクラスに伝える
Private Sub TglBtnRev_Change()
PEO.Reverse = TglBtnRev.Value
End Sub
Private Sub UserForm_Initialize()
Call PrepareControls
Set PEO = New clsProgressElements
Set PEO2 = New clsProgressElements
Set PEO.Bar = LabelBar
Set PEO2.Bar = LabelBar2
Set PEOv = New clsProgressElements
Set PEOm = New clsProgressElements
Set PEOs1 = New clsProgressElements
Set PEOs2 = New clsProgressElements
Set PEOs3 = New clsProgressElements
Set PEOv.Bar = LabelBarV
PEOv.Vertical = True
Set PEOm.Bar = LabelMqe
Set PEOs1.Bar = LabelStl1
Set PEOs2.Bar = LabelStl2
Set PEOs3.Bar = LabelStl3
End Sub
Private Sub UserForm_Terminate()
Set PEO = Nothing
Set PEO2 = Nothing
Set PEOv = Nothing
Set PEOm = Nothing
Set PEOs1 = Nothing
Set PEOs2 = Nothing
Set PEOs3 = Nothing
End Sub
Rem デモに必要なコントロールの配置
Private Sub PrepareControls()
Const SIZE_MARGIN As Single = 6
Const SIZE_WIDTH As Single = 210
Const SIZE_HEIGHT As Single = 15
Const SIZE_2PIXEL As Single = 2 * 72 / 96
Const SPIN_RANGE As Long = 3000
Rem Frame1
With Me.Controls.Add("Forms.Frame.1", "Frame1")
.Top = SIZE_MARGIN
.Left = SIZE_MARGIN
.Width = SIZE_WIDTH
.Height = SIZE_HEIGHT
.ControlTipText = "クリックした場所が何％なのかをタイトルバーに表示"
End With
Set Frame1 = Me.Controls("Frame1")
Frame1.SpecialEffect = fmSpecialEffectSunken
Rem LabelBar2 背面のバー(10%刻み伸縮)
With Frame1.Controls.Add("Forms.Label.1", "LabelBar2")
.Top = 0
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT - SIZE_2PIXEL * 2
End With
Set LabelBar2 = Me.Controls("LabelBar2")
LabelBar2.BackColor = &HC0C0C0
Rem LabelBar 前面のバー(1%刻み伸縮。反転ボタン対応)
With Frame1.Controls.Add("Forms.Label.1", "LabelBar")
.Top = 0
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT - SIZE_2PIXEL * 2
End With
Set LabelBar = Me.Controls("LabelBar")
With LabelBar
.BackColor = &H8000000D
.TextAlign = fmTextAlignRight
.WordWrap = False
End With
Rem LabelCap バーの真ん中でパーセント表示するラベル
With Frame1.Controls.Add("Forms.Label.1", "LabelCap")
.Top = 0
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT - SIZE_2PIXEL * 2
End With
Set LabelCap = Me.Controls("LabelCap")
With LabelCap
.TextAlign = fmTextAlignCenter
.BackStyle = fmBackStyleTransparent
.Font.Size = 11
.Caption = "0%"
End With
Rem LabelCap2 バーの伸縮に連動して移動しながらパーセント表示するラベル
With Frame1.Controls.Add("Forms.Label.1", "LabelCap2")
.Top = 1
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT - SIZE_2PIXEL * 2
.ControlTipText = "このラベルはフレーム内でドラッグできる"
End With
Set LabelCap2 = Me.Controls("LabelCap2")
With LabelCap2
.TextAlign = fmTextAlignCenter
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.Caption = "0000%"
.AutoSize = True
.AutoSize = False
.Caption = "0%"
End With
Rem Spin1
With Me.Controls.Add("Forms.SpinButton.1", "Spin1")
.Top = Frame1.Top + Frame1.Height + SIZE_2PIXEL
.Left = Frame1.Left + SIZE_WIDTH / 3
.Width = SIZE_WIDTH / 3
.Height = SIZE_HEIGHT + SIZE_2PIXEL * 2
.ControlTipText = "±" & SPIN_RANGE & "の間で増減"
End With
Set Spin1 = Me.Controls("Spin1")
With Spin1
.Max = SPIN_RANGE
.Min = -SPIN_RANGE
End With
Rem TglBtnFlip バーの向き反転ボタン
With Me.Controls.Add("Forms.ToggleButton.1", "TglBtnFlip")
.Top = Frame1.Top + Frame1.Height + SIZE_2PIXEL
.Left = Frame1.Left
.Width = SIZE_WIDTH / 3
.Height = SIZE_HEIGHT + SIZE_2PIXEL * 2
.ControlTipText = "バーの向きを反転(左に向かって伸びる)"
End With
Set TglBtnFlip = Me.Controls("TglBtnFlip")
With TglBtnFlip
.Caption = "Flip"
End With
Rem TglBtnRev バーの伸縮反転ボタン
With Me.Controls.Add("Forms.ToggleButton.1", "TglBtnRev")
.Top = Frame1.Top + Frame1.Height + SIZE_2PIXEL
.Left = Frame1.Left + SIZE_WIDTH * 2 / 3
.Width = SIZE_WIDTH / 3
.Height = SIZE_HEIGHT + SIZE_2PIXEL * 2
.ControlTipText = "バーの伸縮を反転(0%でバー幅が最長、100%でバー幅がゼロ)"
End With
Set TglBtnRev = Me.Controls("TglBtnRev")
With TglBtnRev
.Caption = "Reverse"
End With
Rem Frame2
With Me.Controls.Add("Forms.Frame.1", "Frame2")
.Top = Spin1.Top + Spin1.Height + SIZE_MARGIN
.Left = SIZE_MARGIN
.Width = SIZE_WIDTH
.Height = SIZE_HEIGHT * 2 + SIZE_2PIXEL
End With
Set Frame2 = Me.Controls("Frame2")
Frame2.SpecialEffect = fmSpecialEffectSunken
Rem LabelBarV 背面のバー(縦)
With Frame2.Controls.Add("Forms.Label.1", "LabelBarV")
.Top = 0
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT * 2 + SIZE_2PIXEL - SIZE_2PIXEL * 2
End With
Set LabelBarV = Me.Controls("LabelBarV")
LabelBarV.BackColor = &HC0C0C0
Rem LabelMqe マーキーのバー
With Frame2.Controls.Add("Forms.Label.1", "LabelMqe")
.Top = 0
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT / 2 - SIZE_2PIXEL
End With
Set LabelMqe = Me.Controls("LabelMqe")
LabelMqe.BackColor = &H8000000D
Rem LabelStl1 シャトル(1:定速)のバー
With Frame2.Controls.Add("Forms.Label.1", "LabelStl1")
.Top = SIZE_HEIGHT * 0.5
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT / 2 - SIZE_2PIXEL
End With
Set LabelStl1 = Me.Controls("LabelStl1")
LabelStl1.BackColor = &H8000000D
Rem LabelStl2 シャトル(2:振子)のバー
With Frame2.Controls.Add("Forms.Label.1", "LabelStl2")
.Top = SIZE_HEIGHT
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT / 2 - SIZE_2PIXEL
End With
Set LabelStl2 = Me.Controls("LabelStl2")
LabelStl2.BackColor = &H8000000D
Rem LabelStl3 シャトル(3:減速)のバー
With Frame2.Controls.Add("Forms.Label.1", "LabelStl3")
.Top = SIZE_HEIGHT * 1.5
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT / 2 - SIZE_2PIXEL
End With
Set LabelStl3 = Me.Controls("LabelStl3")
LabelStl3.BackColor = &H8000000D
Rem LabelCap3 バーの真ん中で経過ミリ秒を表示するラベル
With Frame2.Controls.Add("Forms.Label.1", "LabelCap3")
.Top = SIZE_HEIGHT / 2
.Left = 0
.Width = SIZE_WIDTH - SIZE_2PIXEL * 2
.Height = SIZE_HEIGHT - SIZE_2PIXEL * 2
End With
Set LabelCap3 = Me.Controls("LabelCap3")
With LabelCap3
.TextAlign = fmTextAlignCenter
.BackStyle = fmBackStyleTransparent
.Font.Size = 11
.Caption = "0.00sec"
End With
Rem UserFormのサイズ
Me.Width = Me.Width - (Me.InsideWidth - Frame1.Left - Frame1.Width) + SIZE_MARGIN
Me.Height = Me.Height - (Me.InsideHeight - Frame2.Top - Frame2.Height) + SIZE_MARGIN
End Sub
（白茶） 2022/05/11(水) 10:44
[20220504065443]
検索ワードのセンスについては言及しないが、1週間以内に同じようなことを言われてる方がいるようですよ。
本人が気づいているだろうから、擁護人は出てこなくてよい。
そもそも過去ログ検索は機能しているのか？
「気分」で検索してもこのスレは無かったようだが。
（短気回答者） 2022/05/11(水) 11:06
ああ、あの嘘八百とかいう荒らしのスレか。
特に問題なく問題が解決してるように見えるが？ たまに部外者が質問者を騙って回答にキレてる のを見ることがあるが、それでもなさそうだし。
なぜ「20220504065443」を持ち出してきたのか 意味不明。
捨てHNはこれ以上相手にしないので私のコメント に対するレスは不要です。
反応したいのなら、新規スレッドを立ち上げて マスターベーションしてください。 （OK） 2022/05/11(水) 11:34
最大値をどういう風に入れればいいか悩んでいます。
ステータスバーだとちょい見にくいのでユーザーフォームを選択しました。
（実装野郎） 2022/05/11(水) 22:26
ユーザーフォームに引数を受け取れる関数を作成し、
パーセントを渡せば分かりやすいかと。
＞最大値をどういう風に入れればいいか悩んでいます。
何を悩んでいるか分かりません。
プロシージャを分けて、各々仕事をさせるように
考えてみてはいかがでしょう。
いいからコードをくれ！というならばお断りしますが。
（tkit） 2022/05/12(木) 09:00
一番簡単なひながたってことで
' 標準モジュール
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub sample()
Const DispStep As Long = 10 ' プログレスバーを 10段階で表示更新
Dim MaxStep As Long, Skip As Long
MaxStep = 100 ' ここはご自分で
Skip = MaxStep \ DispStep
UserForm1.Show vbModeless
UserForm1.Progress = 0
For i = 0 To MaxStep
'-- ここに作業 ----------
Sleep 1 ' 作業がわり
'----------------------
If i >= Skip Then ' プログレスバーの表示を更新
UserForm1.Progress = 100 * i / MaxStep ' UserForm1.Progress に進捗 0 〜 100 を代入
Skip = Skip + MaxStep \ DispStep
End If
Next
MsgBox "完了"
Unload UserForm1
End Sub
' ------ Userform1 --------------
Private Const FormWidth = 400, FormHeight = 100
Private Back As MSForms.TextBox, PBar As MSForms.Label
Private Sub UserForm_Initialize() ' デザインしてたら不要
Set Back = Me.Controls.Add("Forms.TextBox.1")
Set PBar = Me.Controls.Add("Forms.Label.1")
With Me
.Width = FormWidth
.Height = FormHeight
End With
With Back
.Enabled = False
.Top = (Me.InsideHeight - .Height) * 0.5
.Left = FormWidth * 0.1
.Width = FormWidth * 0.8
End With
With PBar
.Enabled = False
.Top = Back.Top + 2
.Left = Back.Left + 2
.Width = 0
.Height = Back.Height - 4
.BackColor = RGB(0, 0, 255)
End With
End Sub
Public Property Let Progress(ByVal vNewValue As Variant)
PBar.Width = (Back.Width - 4) * vNewValue / 100
Me.Repaint
DoEvents: DoEvents
End Property
' ----- UserForm1 ここまで --------------
（´・ω・`） 2022/05/12(木) 10:01
紹介した参考ページを使うのであれば、下記のような感じです。 ＞ループごとに、個数ベースでの進捗率を表示すればよいのでは？ と書いたとおりなんですけどねえ。
UserFormにProgressBar（や必要ならラベルも）を事前に配置しておきます。 標準モジュールに、以下のようなコードを作成します。
Option Explicit
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub sample()
Dim MaxStep As Long
Dim i As Long
MaxStep = 100 ' ここはご自分で
UserForm1.Show vbModeless
UserForm1.ProgressBar1 = 0
For i = 0 To MaxStep
Sleep 1 ' 作業がわりの一例です。
UserForm1.ProgressBar1 = = 100 * i / MaxStep
Next
MsgBox "完了"
Unload UserForm1
End Sub
（（´・ω・`）さんのコードをお借りしました。）
■ 負荷のかかる多数回のシミレーションの進捗を表示するような場合、 私は、できるだけ負荷のかからないStatusBarを使うことが多いですね。 進捗を測るために進捗が遅くなっては元も子もないわけです。 個人で使うのであれば、(回数と)実際の進捗度の数値があれば機能的には十分です。
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub sample2()
Dim MaxStep As Long
Dim i As Long
MaxStep = 100 ' ここはご自分で
For i = 0 To MaxStep
Sleep 1 ' 作業がわり
Application.StatusBar = i & " / " & MaxStep & "( " & 100 * i / MaxStep & " %)"
Next
MsgBox "完了"
Application.StatusBar = False
End Sub
（γ） 2022/05/12(木) 12:18
ProgressBar コントロールって64bit版だと使えないんですよね
私の個人的事情ですが、デスクトップPCで64bit版、ノートPCで32Bit版と使い分けているので ProgressBar コントロールは使わないで、共通に使えるコントロールで自作してます。 といっても、昔作ったのを使い回してるだけですが （´・ω・`） 2022/05/12(木) 12:58
しかし、ユーザーフォームはでるのですが、プログレスバーを組み込んでいるのですが
でませんでした。
以下がコードとなります。
初めに書いたコードと違いますがご容赦を。
Private Sub CommandButton1_Click()
Dim FolderPath As String
Dim FileInt As Long
Dim FSO As Object
'ファイルシステムオブジェクトをセットする
Set FSO = CreateObject("Scripting.FileSystemObject")
FolderPath = "C:\Users\****\Desktop\****\****" 'フォルダを指定する
FileInt = FSO.GetFolder(FolderPath).Files.Count '指定したフォルダ内のファイル数を取得する
Dim MaxStep As Long
Dim i As Long
MaxStep = FileInt
UserForm1.Show vbModeless
UserForm1.ProgressBar1 = 0
For i = 0 To MaxStep
Application.ScreenUpdating = False
Dim buf As String
Dim wb As Workbook
Dim wb2 As Workbook
Dim LstRow1 As Long
Dim LstRow2 As Long
Set wb = ThisWorkbook
buf = Dir(ThisWorkbook.Path & "\*****\*.xlsm")
Set wb = ThisWorkbook
Application.DisplayAlerts = False
Do While buf <> ""
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\****\" & buf)
LstRow1 = wb2.Worksheets("ttttt").Cells(Rows.Count, 1).End(xlUp).Row
wb2.Worksheets("uuuuu").Range("A3:E" & LstRow1).Copy
LstRow2 = wb.Worksheets("iiiii").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Worksheets("iiiii").Range("A" & LstRow2).PasteSpecial xlPasteValues
wb2.Close
buf = Dir()
Loop
UserForm1.ProgressBar1 = 100 * i / MaxStep
Next
MsgBox "完了"
Unload UserForm1
Application.ScreenUpdating = True
End Sub
どこが問題かをご教授願います。
（マウス） 2022/05/12(木) 22:41
どこが問題かと言われても、こちらは千里眼は持ち合わせていないので、 あなたの環境（データ内容等）は不明です。 ですので、基本的にはご自分で調べる必要があります。
(1)UserForm側の確認 ・2022/05/12(木) 12:18のコードを実行して、動作するか確認してください。 （正常動作したものを提示しています。） ・ProgressBarのMin,Maxの値はデフォルトのままなので、 0と100になっていることを前提としています。 実際にその値になっているかを確認のこと。 ・現在のコードでUserFormがどのような表示になるのか、ステップ実行などをして確認のこと。
(2)UserForm以外の部分の確認 まず、結果（値のコピー）が正常になされているかを確認してください。 ファイル数がn個あると、(n×n)回のコピーがされているように見えます。 それはあなたの意図したことなのか、こちらからは不明です。 そもそも、ProgressBar以前に、正しい処理になっているかが重要です。
なお、インデントをしっかりつけるようにしたほうがいいですよ。 これではコードの構造がとても分かりにくいです。 自分で自分にハンディキャップを課しているような印象です。 （γ） 2022/05/13(金) 07:10
■１
Set FSO = CreateObject("Scripting.FileSystemObject")
FileInt = FSO.GetFolder(FolderPath).Files.Count
↑だと、「FileInt」に格納されるのは【xlsm】以外のファイルも含めたものになります。
しかし、実際の処理対象は【xlsm】ファイルだけのようですから、そのまま母数として使ってしまうと違う場合もあるんじゃないでしょうか。
【参考】 https://officedic.com/excel-vba-fsofolder-file-count/
■２
上記に関連しますが↓のようになっているので、結果として合ってるのかもしれませんが、統一されたほうがメンテナンスしやすいでしょう。
【ファイル数のカウント対象 】 "C:\Users\****\Desktop\****\****" 【ブックが入っているフォルダ】ThisWorkbook.Path & "\****"
■３
LstRow2 = wb.Worksheets("iiiii").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Worksheets("iiiii").Range("A" & LstRow2).PasteSpecial xlPasteValues
↑は↓でも同じ意味になると思いますよ。
wb.Worksheets("iiiii").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
■４
既に案内がありますが、簡単な進捗状況を表示させたいだけならばステータスバーをつかうというアプローチもあります。
【参考】 http://officetanaka.net/excel/vba/tips/tips13.htm
■５
ということを踏まえると、このようなアプローチで考えてみるのもよいかもしれません。（対象ファイルを「*.xls?」にしてあります）
興味があれば、【ステップ実行】して研究のうえ必要な部分をご自身のコードに組み込んでみて下さい。
(理解していただきたいので丸パクリして完成！というのは禁止します。)
Sub 研究用()
Dim 対象フォルダパス As String
Dim MyFile As Object
Dim i As Long
Dim ファイル名配列() As String
Dim 対象ファイル数 As Long
Dim 転記元の最終行 As Long
Dim dstRNG As Range
対象フォルダパス = ThisWorkbook.Path & "\hoge"
'▼対象ファイル（ブック）名を配列変数に格納する処理
Stop
For Each MyFile In CreateObject("Scripting.FileSystemObject").GetFolder(対象フォルダパス).Files
If MyFile.Name Like "*.xls?" Then
ReDim Preserve ファイル名配列(i)
ファイル名配列(i) = MyFile.Name
i = i + 1
End If
Next
'▼対象ファイルがあるかチェック
Stop
On Error Resume Next
対象ファイル数 = UBound(ファイル名配列) + 1
On Error GoTo 0
If 対象ファイル数 = 0 Then
MsgBox "対象ファイルがありません"
Exit Sub
End If
'▼出力（貼付）先のセルを特定
Stop
Set dstRNG = ThisWorkbook.Worksheets("iiiii").Cells(Rows.Count, "B").End(xlUp).Offset(1)
Application.ScreenUpdating = False
For i = 0 To UBound(ファイル名配列)
'▼転記（コピペ）処理
Stop
With Workbooks.Open(対象フォルダパス & "\" & ファイル名配列(i)).Worksheets("uuuuu")
転記元の最終行 = .Cells(.Rows.Count, 1).End(xlUp).Row
If 転記元の最終行 >= 3 Then
.Range("A3:E" & 転記元の最終行).Copy
dstRNG.PasteSpecial xlPasteValues
dstRNG.Offset(, -1).Resize(転記元の最終行 - 2).Value = ファイル名配列(i)
Set dstRNG = dstRNG.Offset(転記元の最終行 - 2)
Else
dstRNG.Offset(, -1).Value = ファイル名配列(i)
dstRNG.Value = "データなし"
Set dstRNG = dstRNG.Offset(1)
End If
End With
Workbooks(ファイル名配列(i)).Close False
'▼処理状況の表示処理
Stop
Application.StatusBar = i + 1 & "/" & 対象ファイル数 & "件の処理が完了しました 進捗率：" & Int((i + 1) / 対象ファイル数 * 100) & "%"
Next i
Application.ScreenUpdating = True
MsgBox "すべての処理がおわりました"
Application.StatusBar = False
End Sub
（もこな２ ） 2022/05/13(金) 15:02
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.