Results of 1 - 1 of about 37684 for IF (0.008 sec.)
- [[20220511071313]]
- #score: 1591
- @digest: 6c4965def87c96e39639a689828036c2
- @id: 91229
- @mdate: 2022-05-13T06:02:46Z
- @size: 51308
- @type: text/plain
- #keywords: 2pixel (167167), ptopdef (121797), pleftdef (121797), maxstep (119881), pheightdef (117121), pwidthdef (117121), margin (107504), pbarobject (106830), clsprogresselements (97601), updatebar (89979), smqcount (89172), labelcap2 (79658), property (73908), pvalue (69624), 伸縮 (65889), pmin (65067), frame2 (54200), frame1 (43942), size (31091), single (27464), controls (20422), height (18796), rem (18556), 進捗 (16670), label (16630), width (15330), ptrsafe (15218), スバ (15207), declare (15183), 象フ (15086), public (14433), msforms (13769)
- 『ユーザーフォームのプログレスバーで進捗を見たい』（実装野郎）
おはようございます。 再度お世話になります。 処理中の進捗をユーザーフォームのプログレスバーで見る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 ＞ ---- http://officetanaka.net/excel/vba/filesystemobject/folder06.htm などを使って、予めファイルの個数を調べておき、 ループごとに、個数ベースでの進捗率を表示すればよいのでは? "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 ---- 失礼しました。 とりあえず調べながらやってみます。 気分を悪くさせてすみませんでした。 （実装野郎） 2022/05/11(水) 09:51 ---- ＞気分を悪くさせてすみませんでした。 この文言ある特定の回答者に対してよく聞くセリフだな。 落ち着けよ。 （短気回答者） 2022/05/11(水) 10:06 ---- >＞気分を悪くさせてすみませんでした。 >この文言ある特定の回答者に対してよく聞くセリフだな。 「気分を悪く」で過去ログ検索してみたが、このスレの回答者 が回答したスレはヒットしなかった。 このスレの回答者に向けたコメントではないとしたら、なぜ このスレに書き込んだのか意味不明だ。 （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 3分の1幅のバーが通り過ぎていくモード Rem Stepはバーが自幅分の移動に必要な移動回数(Step×4回呼び出したら一周(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 3分の1幅のバーが行ったり来たりするモード 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 ---- 読解力までもないのか。 つっかかってきては、いいように発散しては撤退。 そして、またもワードセンスがきしょい。 捨てHNや荒らしより、レベルの低い"正当な回答者"でしたか。 論破されることに嫌気がさしたのかな。 このスレには短気がもう1人いたというオチでした。 （短気回答者） 2022/05/11(水) 11:46 ---- アドバイスを参考に フォルダ内のファイル個数をカウントして カウントした個数がプログレスバーの最大値になると言う事までは理解出来ました。 コードにはしてませんが。 最大値をどういう風に入れればいいか悩んでいます。 ステータスバーだとちょい見にくいのでユーザーフォームを選択しました。 （実装野郎） 2022/05/11(水) 22:26 ---- プログレスバーをシンプルに作るのなら、 Labelオブジェクト2つで出来ます。 1つを枠用、2つ目を重ね、進捗表示として。 進捗によって、2つ目のWidthを伸ばしていけば、 それなりに見えます。 ユーザーフォームに引数を受け取れる関数を作成し、 パーセントを渡せば分かりやすいかと。 ＞最大値をどういう風に入れればいいか悩んでいます。 何を悩んでいるか分かりません。 プロシージャを分けて、各々仕事をさせるように 考えてみてはいかがでしょう。 いいからコードをくれ!というならばお断りしますが。 （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 ---- 前段の議論は、ほぼみてませんが「2022/05/12(木) 22:41」に提示されたコードを拝見しての感想です。 ■1 Set FSO = CreateObject("Scripting.FileSystemObject") FileInt = FSO.GetFolder(FolderPath).Files.Count ↑だと、「FileInt」に格納されるのは【xlsm】以外のファイルも含めたものになります。 しかし、実際の処理対象は【xlsm】ファイルだけのようですから、そのまま母数として使ってしまうと違う場合もあるんじゃないでしょうか。 【参考】 https://officedic.com/excel-vba-fsofolder-file-count/ ■2 上記に関連しますが↓のようになっているので、結果として合ってるのかもしれませんが、統一されたほうがメンテナンスしやすいでしょう。 【ファイル数のカウント対象 】 "C:¥Users¥****¥Desktop¥****¥****" 【ブックが入っているフォルダ】ThisWorkbook.Path & "¥****" ■3 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 ■4 既に案内がありますが、簡単な進捗状況を表示させたいだけならばステータスバーをつかうというアプローチもあります。 【参考】 http://officetanaka.net/excel/vba/tips/tips13.htm ■5 ということを踏まえると、このようなアプローチで考えてみるのもよいかもしれません。（対象ファイルを「*.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 （もこな2 ） 2022/05/13(金) 15:02... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202205/20220511071313.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97043 documents and 608212 words.
訪問者：