• ベストアンサー

プログラスバー表示の更新について

office365 ,office2016でも同じ serial1のシートが50件,serial2のシートが10件の状態で macro1,macro2を連続して実行すると macro1の内容のプログレスバーは正しく表示するが、 macro2のプログレスバーは100%の時点で最大までいかない。 excelファイルを閉じて、 macro2,macro1の順に連続して実行すると macro2の内容のプログレスバーは正しく表示するが、 macro1のプログレスバーは20%の時点で実行時エラー'380' Invalid property value のエラー表示が出る。 excelファイルを開いて macro1実行し excelファイルを閉じて macro2実行すると 両方のプログレスバー共、正しく表示される また macro1実行しユーザフォームのinfo2をダブルクリックして macro2実行すると 両方のプログレスバー共、正しく表示される という状況です。 serialの値が更新されていないのが原因みたいです。 いろいろやってみたのですが、対処内容が分かりません。 どうやったらmacro1,macro2連続実行してプログラスバーの表示が正しく表示されるか教えていただきたく。 ユーザフォームinfo2のマクロ Private Sub UserForm_Initialize() Dim serial As Long serial = Worksheets("MENU").Cells(1, 8).Value With ProgressBar2 .Min = 0 .Max = serial .Value = 0 End With パーセント.Caption = "" End Sub マクロ1 sub macro1() serial = Worksheets("serial1").Cells(Rows.Count, 1).End(xlUp).row Worksheets("MENU").Cells(1, 8).Value = serial 'いろんな処理 info2.Show vbModeless info2.StartUpPosition = 0 info2.Top = 0 info2.Left = 465 ' With info2 .ProgressBar2.Value = I .パーセント.Caption = Int(I / serial * 100) & "%" .kisyu.Caption = Worksheets("serial1").Cells(I, 1).Value .Repaint End With マクロ2 sub macro2() serial = Worksheets("serial2").Cells(Rows.Count, 1).End(xlUp).row Worksheets("MENU").Cells(1, 8).Value = serial 'いろんな処理 info2.Show vbModeless info2.StartUpPosition = 0 info2.Top = 0 info2.Left = 465 ' With info2 .ProgressBar2.Value = I .パーセント.Caption = Int(I / serial * 100) & "%" .kisyu.Caption = Worksheets("serial2").Cells(I, 1).Value .Repaint End With

質問者が選んだベストアンサー

  • ベストアンサー
  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.2

こうゆうことではないでしょうか。 Sub macro1()   '途中略    Dim serial As Long    serial = Worksheets("serial1").Cells(Rows.Count, 1).End(xlUp).Row    info2.ProgressBar2.Max = serial   '途中略 End Sub Sub macro2()   '途中略      Dim serial As Long    serial = Worksheets("serial2").Cells(Rows.Count, 1).End(xlUp).Row    info2.ProgressBar2.Max = serial   '途中略 End Sub

3620313
質問者

お礼

回答ありがとうございます。 無事動作しました。 助かりました。

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (1)

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.1

再現テストは行っていません。 (事実上再現テストができません) 一方、以下が気になります。 再現するコードを提示するとともに I info2 パーセント kisyu それぞれが何者なのかを明示してもらわないと評価ができません。 I これは整数型の変数ですか? info2 これはフォームのオブジェクト名ですね? パーセント kisyu これらは、 info2 に配置したLabelですか? 提示されたコードを見る限り、 Private Sub UserForm_Initialize() Dim serial As Long serial = Worksheets("MENU").Cells(1, 8).Value この serial と sub macro1() serial = Worksheets("serial1").Cells(Rows.Count, 1).End(xlUp).row この serial と sub macro2() serial = Worksheets("serial2").Cells(Rows.Count, 1).End(xlUp).row この serial は 別物として扱われますが、それで正しいですか? 更に、 macro1のプログレスバーは20%の時点で実行時エラー'380' Invalid property value このエラーは、 With info2 .ProgressBar2.Value = I このコードで起きているものと思います。 まずは、 Option Explicit をコード先頭に書き加え https://tonari-it.com/excel-vba-debug-print/ を参考に With info2 .ProgressBar2.Value = I を With info2  Debug.print I .ProgressBar2.Value = I とすることで Iに埋まっている値を確認してみてください。

3620313
質問者

補足

回答ありがとうございます。 下記に回答します。 再現するコード Option Explicit Sub macro1() Application.ScreenUpdating = False Dim serial As Long serial = Worksheets("serial1").Cells(Rows.Count, 1).End(xlUp).row Worksheets("MENU").Cells(1, 8).Value = serial Dim I  As  Long I = 1 Do Until Worksheets("serial1").Cells(I, 1) = "" Worksheets("serial1").Cells(I, 7).copy _ Destination:=Worksheets("MENU").Cells(5, 3) info2.Show vbModeless info2.StartUpPosition = 0 info2.Top = 0 info2.Left = 465 With info2 Debug.Print I .ProgressBar2.Value = I .パーセント.Caption = Int(I / serial * 100) & "%" .kisyu.Caption = Worksheets("serial1").Cells(I, 1).Value .Repaint End With I = I + 1 Loop Application.ScreenUpdating = True End Sub Sub macro2() Application.ScreenUpdating = False Dim serial As Long serial = Worksheets("serial2").Cells(Rows.Count, 1).End(xlUp).row Worksheets("MENU").Cells(1, 8).Value = serial Dim  I  As  Long I = 1 Do Until Worksheets("serial2").Cells(I, 1) = "" Worksheets("serial2").Cells(I, 7).copy _ Destination:=Worksheets("MENU").Cells(5, 3) info2.Show vbModeless info2.StartUpPosition = 0 info2.Top = 0 info2.Left = 465 With info2 Debug.Print I .ProgressBar2.Value = I .パーセント.Caption = Int(I / serial * 100) & "%" .kisyu.Caption = Worksheets("serial2").Cells(I, 1).Value .Repaint End With I = I + 1 Loop Application.ScreenUpdating = True End Sub serial1シート A列   G列 A001   ABC A002   ABC A003   ABC … A049   ABC A050   ABC serial2シート A列   G列 B001   XYZ B002   XYZ B003   XYZ … B009   XYZ B010   XYZ の様な構成です。 なお、だいぶ省略しています。 ホントは2000行くらいでもっといろいろな処理があるのですが、上記内容は再現する最低限の内容になってます。 I info2 パーセント kisyu それぞれが何者なのかを明示してもらわないと評価ができません。 I これは整数型の変数ですか? → そうです。何行目の物件を処理してるという意味です。 info2 これはフォームのオブジェクト名ですね? → そうです。ユーザフォームです。 パーセント kisyu これらは、 info2 に配置したLabelですか? → そうです パーセント:全体の何%目くらいを実行中の表示用です。 kisyu:A列のデータを表示させます。 提示されたコードを見る限り、 Private Sub UserForm_Initialize() Dim serial As Long serial = Worksheets("MENU").Cells(1, 8).Value この serial と sub macro1() serial = Worksheets("serial1").Cells(Rows.Count, 1).End(xlUp).row この serial と sub macro2() serial = Worksheets("serial2").Cells(Rows.Count, 1).End(xlUp).row この serial は 別物として扱われますが、それで正しいですか? → 違います。 UserFormのserialとmacro1のserialは同じものとして扱いたい UserFormのserialとmacro2のserialは同じものとして扱いたい macro1のserialとmacro2のserialは別物として扱いたい です。 Worksheets("MENU").Cells(1, 8).Valueの部分でserialを共用にし、上記構成を実現しているつもりです。 更に、 macro1のプログレスバーは20%の時点で実行時エラー'380' Invalid property value このエラーは、 With info2 .ProgressBar2.Value = I このコードで起きているものと思います。 → その通りです まずは、 Option Explicit をコード先頭に書き加え https://tonari-it.com/excel-vba-debug-print/ を参考に With info2 .ProgressBar2.Value = I を With info2  Debug.print I .ProgressBar2.Value = I とすることで Iに埋まっている値を確認してみてください。 → macro2を実行後にmacro1を実行すると Iが11と表示されてエラーになります。 プログレスバー表示はFULL表示となってます。 macro2実行後、userformの .Max = serialの値が50になってくれたらよいのですが、このMAX値の更新ができていないのがエラーの原因だと思っていますが、対処内容が分からない次第です。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • プログレスバーでの経過状況表示

    vb.netでのtimerのようなものをやりたくてvbaでプログレスバーを使用して経過状況を表示するプログラムを作りました。プログレスバー自体での視覚的な経過状況表示はできたのですが、現在のパーセンテージをlabelに表示することができません。 Private Sub CommandButton4_Click() Dim i As Long Application.Visible = False i = 1 For i = i To 1000000 UserForm1.ProgressBar1.Value = i / 1000000*100 UserForm1.Label1.Caption =UserForm1.ProgressBar1.Value i = i + 1E-44 Next Application.Visible = True End Sub 上記のようにするとプログラム終了時にlabel1に現在のプログレスバーの値が表示されますが、進行中には表示されないのです。これを進行中も表示させるにはどうしたら良いのでしょうか?

  • ユーザーフォームをWorksheet上で表示

    数日前、このカテゴリで相談した事の続きです。 以前の相談は、次の通りです。 http://okwave.jp/qa/q8892460.html この相談の中で出来たことは 1 ユーザーフォームを保存終了 2 Worksheet上にボタンを作成、そのボタンをクリックでユーザーフォームを表示 以上のことはできました。 作成したコードは次のとおりです。   '// Private Sub UserForm_Initialize() With Worksheets("Sheet1")  TextBox1 = .Cells(1, 1).Value  TextBox2 = .Cells(2, 1).Value TextBox3 = .Cells(3, 1).Value TextBox4 = .Cells(4, 1).Value TextBox5 = .Cells(5, 1).Value ).Value End With End Sub Private Sub UserForm_Terminate() With Worksheets("Sheet1")  .Cells(1, 1).Value = TextBox1  .Cells(2, 1).Value = TextBox2 .Cells(3, 1).Value = TextBox3 .Cells(4, 1).Value = TextBox4 .Cells(5, 1).Value = TextBox5 End With End Sub '// Private Sub cmdsyuuryo_Click() Unload Me End Sub Private Sub UserForm_Click() Myform.Show vbModeless End Sub そこで質問です。 現在Worksheet上にボタンを作成、クリックしてユーザーフォームを表示しているの を、WorksheetのセルA1(名前を記述してある)をクリックするだけでユーザーフォー ムを表示する方法はありませんか? ユーザーフォームの保存先は「Sheet1」のA1からA5までです。 できれば、この設定で具体的なコードの記述をお願いします。 Excel2013です。 よろしくお願いします。

  • VBAでUserFormでProgressBarとLabelを同時表示できない理由は?

    VBAでUserFormをつかってProgressBarとLabelを同時に表示させる。つもりでしたが、ProgressBarが満たされた後Labelが表示されます。その理由と対策を教えて下さい。そのコードを以下に示します。 Sub a() With UserForm1 .Show vbModeless .Label1 = "始めのテキスト" End With s = 1 e = 20000 For i = s To e UserForm1.Label1 = "始めのテキスト" UserForm1.ProgressBar1.Value = i / e * 1000 Next i End Sub お願いします。

  • エクセル マクロについて

    Sub Macro1() Set in1 = Application.InputBox(prompt:="入力範囲", Type:=8) i = in1.Offset(1, 0).Value Cells(1, 1).Value = i End Sub とするとエラーがでないのですが、 Sub Macro1() Set in1 = Application.InputBox(prompt:="入力範囲", Type:=8) i = in1.Offset(1, 0).Value Cells(1, 1).Value = i + 1 End Sub とするとエラーがでます。 i+1を表示するには、どう修正すればよいでしょうか。

  • ユーザーフォームをWorkSheet(1)に固定

    ●質問の主旨 WorkSheet(1)(「柴田8月分」)にユーザーフォームを固定的に 表示させつつ、WorkSheet(1)以降のWorkSheet(2)、 WorkSheet(3)、WorkSheet(4)の表を参照しながら ComboBox1、ComboBox2、ComboBox3にリストを 選択して、データベースに入力したいと考えています。 以下のコードをどのように書き換えれば良いでしょうか? ご教示のほどよろしくお願い申し上げます。 ●質問の補足 現在のコードでは、ComboBox1、ComboBox2、ComboBox3を それぞれ選択しているとユーザーフォームがそれぞれ WorkSheet(2)、WorkSheet(1)(顧客リスト)、WorkSheet(3)(社員名)、 WorkSheet(4)(大分類)にとんでしまいます。 転記入力が終了すると、また手作業でWorkSheet(1)に戻らなければなりません。 その手作業を回避したいと考えています。 なお添付画像はComboBox1の選択前なのでWorkSheet(1) に留まってくれています。 ●コード Option Explicit 'ユーザーフォームの初期化 Private Sub UserForm_Initialize() Dim r As Range Dim n As Range Dim d As Range With Worksheets(2) Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox1 .ColumnCount = 2 .ColumnWidths = ";0" .List = r.Value End With With Worksheets(3) Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox2 .ColumnCount = 2 .ColumnWidths = ";0" .List = n.Value End With With Worksheets(4) Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox3 .ColumnCount = 2 .ColumnWidths = ";0" .List = d.Value End With Set r = Nothing Set n = Nothing Set d = Nothing TextBox3.Value = Worksheets(1).Range("A2").Value + 1 txtdate = Date OptionButton1.Value = True End Sub 'ComboBox1をクリックしたときの処理 Private Sub ComboBox1_Click() Worksheets(2).Select With Me.ComboBox1 Me.Label19.Caption = .List(.ListIndex, 1) Worksheets(2).Select Replace:=False End With End Sub 'ComboBox2をクリックしたときの処理 Private Sub ComboBox2_Click() Worksheets(3).Select With Me.ComboBox2 Me.Label20.Caption = .List(.ListIndex, 1) Worksheets(3).Select Replace:=False End With End Sub 'フォームからデータベースへの転記 Private Sub CommandButton3_Click() Dim Rowpos As Long Dim ColPos As Long Rowpos = Worksheets("柴田8月分").Range("a10000").End(xlUp).Row ColPos = 1 Rowpos = Rowpos + 1 With Worksheets("柴田8月分") .Cells(Rowpos, ColPos) = TextBox3.Value .Cells(Rowpos, ColPos + 1) = txtdate.Value .Cells(Rowpos, ColPos + 2) = Label19.Caption .Cells(Rowpos, ColPos + 3) = ComboBox1.Text .Cells(Rowpos, ColPos + 4) = ComboBox2.Text .Cells(Rowpos, ColPos + 5) = Label20.Caption .Cells(Rowpos, ColPos + 6) = ComboBox3.Text End With 'Noの加算 Dim i As Long For i = 1 To 1 Step 1 TextBox3.Value = TextBox3.Value + 1 Next Call Clearcmb End Sub 'データベース入力後にコンボボックスを空欄にする Private Sub Clearcmb() ComboBox1.Text = "" ComboBox2.Text = "" ComboBox3.Text = "" End Sub 'ユーザーフォームの終了 Private Sub CommandButton5_Click() Unload UserForm1 End End Sub 以上よろしくお願い申し上げます。使用機種はWindowsVistaで、 Excel2007です。私はVBA初心者です。

  • インデックスが有効範囲に出ないと出る

    下記のようなVBAを書きました。しかしインデックスが有効範囲にないとメッセージがでるのですが、どこがまちがっているでしょうか?? Sub macro1() Dim i As Long Dim r As Long Worksheets("フェアリスト ").Select Worksheets("csv").Range("A:C").ClearContents For i = 2 To 50 Step 5 If Worksheets("フェアリスト").Cells(11, i + 1) <> "" Then r = Worksheets("フェアリスト").Cells(65536, i + 1).End(xlUp).Row Worksheets("フェアリスト").Range(Cells(11, i), Cells(r, i + 3)).Copy _ Destination:=Worksheets("csv").Range("B65536").End(xlUp).Offset(1) Worksheets("csv").Range("A65536").End(xlUp).Offset(1).Resize(r - 3, 1).Value = Worksheets("フェアリスト").Cells(8, i).Value End If Next i Worksheets("csv").Range("A1:C1").Delete shift:=xlShiftUp End Sub

  • VBA プロシージャが大きすぎます

    皆様、こんにちは。 次のようなプロシージャを書きましたが、プロシージャが大きすぎますというエラーメッセージが出てしまいます。最初は2つのサブに分けてみましたが、正しく動かなくなりました。できれば、文書自体を短くしたいですが、方法がありましたら教えてください。どうぞよろしくお願いします。 Sub Test() Dim nR As Long Dim nC As Long Dim i As Long nR = 2 nC = 2 i = 68 i1 = 69 i2 = 70 ... i41 = 110 With Worksheets(1) Do If .Cells(i, 11).Value <> "" Then With Worksheets(2) Do If .Cells(nR, nC).Value = "" Then Exit Do End If nR = nR + 41 Loop .Cells(nR, nC).Value = "1.1" .Cells(nR, nC + 1).Value = "計" .Cells(nR, nC + 2) = Worksheets(1)Cells(i, 14) .Cells(nR, nC + 3) = Worksheets(1).Cells(i, 15) .Cells(nR, nC + 4) = Worksheets(1).Cells(i, 16) .Cells(nR, nC + 5) = Worksheets(1).Cells(i, 17) .Cells(nR, nC + 6) = Worksheets(1).Cells(i, 18) .Cells(nR, nC + 7) = Worksheets(1).Cells(i, 19) .Cells(nR, nC + 8) = Worksheets(1).Cells(i, 20) .Cells(nR, nC + 9) = Worksheets(1).Cells(i, 21) .Cells(nR, nC + 10) = Worksheets(1).Cells(i, 22) .Cells(nR, nC + 11) = Worksheets(1).Cells(i, 23) .Cells(nR, nC + 12) = Worksheets(1).Cells(i, 24) .Cells(nR, nC + 13) = Worksheets(1).Cells(i, 25) .Cells(nR, nC + 14) = Worksheets(1).Cells(i, 26) .Cells(nR, nC + 15) = Worksheets(1).Cells(i, 27) .Cells(nR, nC + 16) = Worksheets(1).Cells(i, 28) .Cells(nR, nC + 17) = Worksheets(1).Cells(i, 29) ... .Cells(nR + 41, nC + 1).Value = "燃料" .Cells(nR + 41, nC + 2) = Worksheets(1).Cells(i + 41, 14) .Cells(nR + 41, nC + 3) = Worksheets(1).Cells(i + 41, 15) .Cells(nR + 41, nC + 4) = Worksheets(1).Cells(i + 41, 16) .Cells(nR + 41, nC + 5) = Worksheets(1).Cells(i + 41, 17) .Cells(nR + 41, nC + 6) = Worksheets(1).Cells(i + 41, 18) .Cells(nR + 41, nC + 7) = Worksheets(1).Cells(i + 41, 19) .Cells(nR + 41, nC + 8) = Worksheets(1).Cells(i + 41, 20) .Cells(nR + 41, nC + 9) = Worksheets(1).Cells(i + 41, 21) .Cells(nR + 41, nC + 10) = Worksheets(1).Cells(i + 41, 22) .Cells(nR + 41, nC + 11) = Worksheets(1).Cells(i + 41, 23) .Cells(nR + 41, nC + 12) = Worksheets(1).Cells(i + 41, 24) .Cells(nR + 41, nC + 13) = Worksheets(1).Cells(i + 41, 25) .Cells(nR + 41, nC + 14) = Worksheets(1).Cells(i + 41, 26) .Cells(nR + 41, nC + 15) = Worksheets(1).Cells(i + 41, 27) .Cells(nR + 41, nC + 16) = Worksheets(1).Cells(i + 41, 28) .Cells(nR + 41, nC + 17) = Worksheets(1).Cells(i + 41, 29) End With Else Exit Do End If i = i + 51 i1 = i1 + 51 ... i41 = i41 + 51 Loop End With End Sub できれば、まとめて .Range(Cells(nR, nC + 2), Cells(nR, nC + 17)).Value = Worksheets(1).Range(Cells(i, 14), Cells(i, 29)).Value のようにしたいですが、これもまたエラーが出てしまいます。

  • 【Excel VBA】データ貼り付けの開始位置について

    Excel2003を使用しています。 先日、こちらでアドバイスをいただきながら、下記のようなマクロを作りました。内容はあるセルの値と同じ名前のシートへデータをコピーするというものです。 Sheet1に貼り付け元のデータが表形式であり、必要なデータのみ該当のシートへコピーします。マクロ実行後は、別の新しいデータをSheet1へコピペして、またマクロを実行するのですが、その際、データの貼り付け開始位置を前回マクロを実行して貼り付けられたデータから2行空けたいのですが、可能でしょうか? ________________________________________________________________________________________________________________________________ Sub test3() Dim n As Long Dim i As Long Dim j As Long  Worksheets("Sheet1").Activate   For n = 4 To Cells(Rows.Count, 2).End(xlUp).Row    If Cells(n, 3).Value <> "" Then     With Worksheets(CStr(Cells(n, 3).Value))       i = .Cells(Rows.Count, 3).End(xlUp).Row + 1       Cells(n, 2).Copy .Cells(i, 2)       Cells(n, 7).Resize(, 2).Copy .Cells(i, 4)       Cells(n, 11).Copy .Cells(i, 3)     End With    End If    If Cells(n, 13).Value <> "" Then     With Worksheets(CStr(Cells(n, 13).Value))       j = .Cells(Rows.Count, 3).End(xlUp).Row + 1       Cells(n, 12).Copy .Cells(j, 2)       Cells(n, 17).Copy .Cells(j, 4)       Cells(n, 18).Copy .Cells(j, 6)       Cells(n, 11).Copy .Cells(j, 3)     End With    End If   Next n End Sub

  • ステータスバーを一定時間後に更新する

    office365 一定時間後(10[S]毎)にステータスバーの進捗状態を更新させたい 下記は、iを1ずつカウントしたらステータスバーを1%~100%まで表示するマクロです。 Sub sample() ' Dim i As Long Dim num As Long UserForm5.Show vbModeless UserForm5.StartUpPosition = 0 UserForm5.Top = 0 UserForm5.Left = 0 i = 1 num = 100 For  i = 1 To  num With UserForm5 .ProgressBar1.Value = i .パーセント.Caption = Int(i / num * 100) & "%" .Repaint End With Next End Sub 上記マクロに、10[s]毎にステータスバーの進捗状態を更新するマクロとしたいのですが、その方法がわからずべたのマクロで教えていただきたく。 10[S]たったら1% 20[S]たったら2% … 1000[s]たったら100% のステータスバーを表示する構成にしたいのです。

  • 【Excel】リストボックスにデータを重複せず昇順に表示する方法

    教えてください。 ユーザーフォームにリストボックス(Listbox1)があり、日付が昇順で入力されるようになっています。 ただし、この日付データは重複が多いため重複されないよう表示しようと下記のコードを記述しましたが「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです」と表示されてしまいます。 これを回避し、実行させるためにはどういう風に記述を修正したらよいでしょうか? ================================================================ Private Sub UserForm_Initialize() Dim i As Long For i = 2 To 2000 ListBox1.AddItem Worksheets("データ").Cells(i, 1) Dim myValue As Variant Dim myRng As Range, myCell As Range Set myRng = Worksheets("データ").Cells(i, 1).End(xlUp) myValue = myRng.Value Application.ScreenUpdating = False myRng.Sort Worksheets("データ").Cells(i, 1), xlAscending, Header:=xlYes With ListBox1 .Clear For Each myCell In myRng.Resize(myRng.Rows.Count - 1).Offset(1) _ .SpecialCells(xlCellTypeVisible) .AddItem myCell.Value Next .ListIndex = 0 End With Next i ListBox1.ListIndex = 0 End Sub ================================================================

専門家に質問してみよう