[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『vbaのユーザーフォームについて教えてください』（初心者）
ユーザーフォームが勝手に閉じてしまいます。
原因はわかりませんが、下記コードを動かすと閉じてしまうようなので、どなたか原因がわかる方教えてください。
Sub Print_Out()
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim i As Long, Idh_Qty As Long, Lbl_Qty As Long, i2 As Long, Col1 As Long, Col6 As Long
Dim Mst_ws As Worksheet, Idh As Worksheet, Lbl As Worksheet
Dim xlApp As Excel.Application
Dim Base_Prnt As String, Idh_Prnt As String, Lbl_Prnt As String, Idh_RngOb(2, 1) As String, Lbl_RngOb(2, 1) As String
Dim MstDt(5)
Set xlApp = CreateObject("Excel.Application")
Set Idh = ThisWorkbook.Sheets(Str_Idh)
Set Lbl = ThisWorkbook.Sheets(Str_Lbl)
Base_Prnt = ActivePrinter
Idh_Prnt = Range("C3")
Lbl_Prnt = Range("C6")
'マスタ工程1〜
Col1 = 13
'マスタ工程6〜
Col6 = 18
Idh_RngOb(0, 0) = "P3"
Idh_RngOb(0, 1) = "P3"
Idh_RngOb(1, 0) = "AB2"
Idh_RngOb(1, 1) = "AA5"
Idh_RngOb(2, 0) = "AU5"
Idh_RngOb(2, 1) = "O7"
Lbl_RngOb(0, 0) = "B4"
Lbl_RngOb(0, 1) = "D5"
Lbl_RngOb(1, 0) = "B10"
Lbl_RngOb(1, 1) = "F8"
Lbl_RngOb(2, 0) = "M19"
Lbl_RngOb(2, 1) = "F20"
Idh.Visible = True
Lbl.Visible = True
For i = 1 To 73 Step 8
If Userform1.Controls("Textbox" & i) <> "" Then
Idh_Qty = Userform1.Controls("Textbox" & i + 6).Text
Lbl_Qty = Userform1.Controls("Textbox" & i + 7).Text
'品番
MstDt(0) = Userform1.Controls("Textbox" & i)
'品名
MstDt(1) = Userform1.Controls("Textbox" & i + 1)
'注番
MstDt(2) = Userform1.Controls("Textbox" & i + 3)
With xlApp.Workbooks.Open(Mst_FlName, UpdateLinks:=False, ReadOnly:=False)
Set Mst_ws = .Sheets("商品登録情報")
'入力された品番でフィルタ
Mst_ws.Range("A1").AutoFilter 1, Userform1.Controls("Textbox" & i).Text
LastRow = Mst_ws.Cells(Rows.Count, 1).End(xlUp).Row
If Mst_ws.Cells(LastRow, 1).Value <> "品番" Then
'棚番
MstDt(3) = Mst_ws.Cells(LastRow, 10).Value
'棚番コード
MstDt(4) = Mst_ws.Cells(LastRow, 9).Value
'材質
MstDt(5) = Mst_ws.Cells(LastRow, 4).Value
Else
'棚番
MstDt(3) = ""
'棚番コード
MstDt(4) = ""
'材質
MstDt(5) = ""
End If
ThisWorkbook.Activate
If Userform1.Controls("Textbox" & i + 6) <> 0 Then
'移動票作成
With Idh
.Activate
.Range("O5").Value = Userform1.Date_.Text
'品番
.Range("AA5") = MstDt(0)
'品名
.Range("AA7") = MstDt(1)
'サイズ
.Range("AA9") = Userform1.Controls("Textbox" & i + 2)
'注番
.Range("O7") = MstDt(2)
'入庫数
.Range("O9") = Userform1.Controls("Textbox" & i + 4)
'ChNo
.Range("AA11") = Userform1.Controls("Textbox" & i + 5)
Mst_ws.Activate
If Mst_ws.Cells(LastRow, 1).Value <> "品番" Then
'材質
.Range("G11") = MstDt(5)
'識別色
.Range("BD13") = Mst_ws.Cells(LastRow, 5).Value
'磁性
.Range("BD23") = Mst_ws.Cells(LastRow, 6).Value
'刻印1
.Range("BD17") = Mst_ws.Cells(LastRow, 7).Value
'刻印2
.Range("BD19") = Mst_ws.Cells(LastRow, 8).Value
'棚番地コード
.Range("P3") = MstDt(4)
'棚番
.Range("P2") = MstDt(3)
'顧客コード
Workbooks("発行用.xlsm").Sheets("顧客リスト").Visible = True
Workbooks("発行用.xlsm").Sheets("顧客リスト").Activate
Range("A1").AutoFilter 1, Mst_ws.Cells(LastRow, 11).Value
If Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Value <> "顧客コード" Then
.Range("AV8") = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2).Value
Else
.Range("AV8") = ""
End If
ActiveSheet.AutoFilterMode = False
Workbooks("発行用.xlsm").Sheets("顧客リスト").Visible = False
Mst_ws.Activate
'工程
For i2 = 15 To 23 Step 2
.Range("E" & i2) = Mst_ws.Cells(LastRow, Col1).Value
.Range("AF" & i2) = Mst_ws.Cells(LastRow, Col6).Value
Col1 = Col1 + 1
Col6 = Col6 + 1
Next i2
ActiveSheet.AutoFilterMode = False
End If
End With
.Close SaveChanges:=False
Idh.Activate
'移動票バーコード作成
For i2 = 1 To 3
With Idh.Range(Idh_RngOb(i2 - 1, 0))
If i2 = 1 Then
ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", link:=False, DisplayAsIcon:=False, _
Top:=.Top + 5, Left:=.Left + 0, Height:=.Height * 1.5, Width:=.Width * 9.9).Select
ElseIf i2 = 2 Then
ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", link:=False, DisplayAsIcon:=False, _
Top:=.Top + 5, Left:=.Left + 2, Height:=.Height * 2, Width:=.Width * 40).Select
Else
ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", link:=False, DisplayAsIcon:=False, _
Top:=.Top + 5, Left:=.Left + 2, Height:=.Height * 2.5, Width:=.Width * 15).Select
End If
End With
With Selection.Object
.Style = 7
.SubStyle = 0
.Validation = 1
.LineWeight = 3
.Direction = 0
.ShowData = 0
.ForeColor = rgbBlack
.BackColor = rgbWhite
.Refresh
End With
With Selection
.Visible = False
.LinkedCell = Range(Idh_RngOb(i2 - 1, 1)).Address(RowAbsolute:=False, ColumnAbsolute:=False, _
ReferenceStyle:=Application.ReferenceStyle)
.Visible = True
End With
Next i2
End If
End With
If Userform1.Controls("Textbox" & i + 7) <> 0 Then
'ラベル作成
With Lbl
.Activate
'棚番
.Range("F2") = MstDt(3)
'棚番コード
.Range("D5") = MstDt(4)
'品番
.Range("F8") = MstDt(0)
'品名
.Range("F14") = MstDt(1)
'材質
.Range("F17") = MstDt(5)
'注番
.Range("F20") = MstDt(2)
End With
'ラベルバーコード作成
For i2 = 1 To 3
With Lbl.Range(Lbl_RngOb(i2 - 1, 0))
If i2 = 2 Then
ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", link:=False, DisplayAsIcon:=False, _
Top:=.Top + 5, Left:=.Left + 5, Height:=.Height * 3, Width:=.Width * 40).Select
Else
ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", link:=False, DisplayAsIcon:=False, _
Top:=.Top + 5, Left:=.Left + 5, Height:=.Height * 3, Width:=.Width * 17).Select
End If
End With
With Selection.Object
.Style = 7
.SubStyle = 0
.Validation = 1
.LineWeight = 3
.Direction = 0
.ShowData = 0
.ForeColor = rgbBlack
.BackColor = rgbWhite
.Refresh
End With
With Selection
.Visible = False
.LinkedCell = Range(Lbl_RngOb(i2 - 1, 1)).Address(RowAbsolute:=False, ColumnAbsolute:=False, _
ReferenceStyle:=Application.ReferenceStyle)
.Visible = True
End With
Next i2
End If
'移動票印刷
If Userform1.Controls("Textbox" & i + 6) <> 0 Then
With Idh
.Activate
With .PageSetup
'印刷横向き
.Orientation = xlLandscape
'上余白
.TopMargin = Application.CentimetersToPoints(0)
'右余白
.RightMargin = Application.CentimetersToPoints(0)
'左余白
.LeftMargin = Application.CentimetersToPoints(3.5)
'下余白
.BottomMargin = Application.CentimetersToPoints(0)
'ヘッダー
.HeaderMargin = Application.CentimetersToPoints(0)
'フッター
.FooterMargin = Application.CentimetersToPoints(0)
'水平
.CenterHorizontally = True
'垂直
.CenterVertically = True
'印刷ページ
.FitToPagesWide = 1
.FitToPagesTall = False
'印刷範囲
.PrintArea = "A1:BO25"
End With
'指定したプリンターで印刷
.PrintOut copies:=Idh_Qty, ActivePrinter:=Idh_Prnt
' Application.Wait (Now + TimeValue("00:00:05"))
All_Delete
.Range("P2,P3,O5,O7,O9,AA5,AA7,AA9,AA11,G11,AV8,E15,E17,E19,E21,E23,AF15,AF17,AF19,AF21,AF23,BD13,BD17,BD19,BD23") = ""
End With
End If
'ラベル印刷
If Userform1.Controls("Textbox" & i + 7) <> 0 Then
With Lbl
.Activate
With .PageSetup
'印刷縦方向
.Orientation = xlPortrait
'印刷ページ
.FitToPagesWide = 1
.FitToPagesTall = False
'印刷範囲
.PrintArea = "A1:AQ23"
End With
'指定したプリンターで印刷
.PrintOut copies:=Lbl_Qty, ActivePrinter:=Lbl_Prnt
' Application.Wait (Now + TimeValue("00:00:05"))
All_Delete
.Range("F2,D5,F8,F14,F17,F20") = ""
End With
Sheets("メイン").Activate
End If
'通常業務用プリンターに戻す
Application.ActivePrinter = Base_Prnt
Else
Exit For
End If
Next i
Idh.Visible = False
Lbl.Visible = False
Set xlApp = Nothing
Application.EnableEvents = True
End Sub
上記コードは標準モジュールで、ユーザーフォームのコマンドボタンからcallさせています。
使用者が別のユーザーフォームに品番などを書いた後ボタンを押すと、上記のマクロが動きます。
処理内容ですが
上記マクロでは、ユーザーフォームに記入された内容とマスタになっている別のエクセルファイルからデータを取り出してあらかじめ別シートに用意しておいた現品票とラベルへ書き込み、必要な所だけバーコード化させた後に印刷をさせています。
動かすと、まったく不具合もエラーもなく正常に動くのですが、何故か処理終了後にユーザーフォームが閉じます。これを修正したいと思っています。
ちなみに、ユーザーフォームのShowmodalはFalseに設定しています。Trueにしたら閉じないのは確認できていますが、フォームを開いたまま別の作業もしたいので、こちらはFalseのままで出来る方法が知りたいです。
どなたかわかる方いましたらご教示お願いします。
＜ 使用 Excel：unknown、使用 OS：unknown ＞
ステップ実行すると、どういったプロセスで終了しますか？ （tkit） 2023/05/24(水) 15:17:41
今ステップインを行ってみた所、
バーコードを作る所から先が「中断モードでは入力できません」と出て、ステップインが出来なくなりました。
継続ボタンを押したらそのまま進んでいき処理終了後にフォームが閉じました。
バーコード生成後にブレークポイントをつけても結果は同じです。
ちなみにですが、呼び出し元のプロシージャの方に、このマクロが終了した後msgで待ち構えていたらそのメッセージは届きましたので、呼び出し元には帰ってきているようです。
（初心者） 2023/05/24(水) 15:45:16
＞そのメッセージは届きましたので、呼び出し元には帰ってきているようです。 上記Msgboxが表示している状態時、Formが閉じていないのであれば、呼び出し元で閉じているのでは？ （tkit） 2023/05/24(水) 15:49:16
Userformが勝手に閉じてしまう原因がわかりません
投稿者 : 初心者 投稿日時 : 2023/05/23(Tue) 11:53:56
https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=1418
（めちゃくちゃ） 2023/05/24(水) 16:08:35
呼び出し元のプロシージャは以下です。
Private Sub Main_Print_Click()
If Sheets("メイン").Cells(3, 3) = "" Or Sheets("メイン").Cells(6, 3) = "" Then
MsgBox "プリンターを記入してください", vbExclamation, "記入漏れ"
Exit Sub
End If
Register (False)
Print_Out
MsgBox 1
'Start_
End Sub
おっしゃる通り、呼び出し元で閉じているのだとは思いますが、
見ての通り、unloadの類も書いておりませんし、更に言うと上の Print_Outをコメントアウトして、Register (False)だけで処理を行った場合はフォームは閉じません。
おまけにその下でコメントアウトしているStart_は動かすとエクセルが閉じてしまい、機能しません。
ですが、これらを個々で動かしてみるとちゃんと動くのでコードミスとかではなさそうです。
（初心者） 2023/05/24(水) 16:10:22
完全独学なので皆さんからしたら低レベルなコード力かもしれませんが、それだけ言いに来るくらいなら何も言わなくていいです。
読まなくても聞かれたらその部分だけコピペしますし、文でも説明しているので。
文句言うならそこのアドバイスでも添えて頂ければ幸いです。
（初心者） 2023/05/24(水) 16:22:14
Macではないです。
Excelは2016
Osは、
Windows10 Pro
バージョン20H2(OS ビルド 19042.1466)
と書いてあります。
（初心者） 2023/05/24(水) 16:45:00
Endとは、Endのみでという事ですか？
それはないですが、end subでは終わらせています。
気になったので一応補足させていただきました。
（初心者） 2023/05/24(水) 17:20:19
当方Excel2010/win7(x86)環境ですけど挙動確認してみました。確かに消えてなくなりますね。 何処で消えてなくなるのか追跡してみました。
Rem ******************************************************************
Rem [UserForm1]モジュール
Rem ******************************************************************
Private Sub UserForm_Click()
Print_Out
Debug.Print Now; "UserForm_Click ", ObjPtr(fm), fm.Visible
MsgBox 1
Debug.Print Now; "after MsgBox 1 ", ObjPtr(fm), fm.Visible
Application.OnTime Now, "printlog"
End Sub
Private Sub UserForm_Deactivate()
Debug.Print Now; "UserForm_Deactivate ", ObjPtr(fm)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Debug.Print Now; "UserForm_QueryClose ", ObjPtr(fm)
End Sub
Private Sub UserForm_Terminate()
Debug.Print Now; "UserForm_Terminate", ObjPtr(fm)
End Sub
Rem ******************************************************************
Rem 標準モジュール
Rem ******************************************************************
Public fm As UserForm1
Sub test()
Set fm = New UserForm1
fm.Show vbModeless
Debug.Print Now; "fm.Show vbModeless", ObjPtr(fm)
End Sub
Sub printlog()
Debug.Print Now; "OnTime printlog", ObjPtr(fm)
End Sub
Set fm = New UserForm1 と Set fm = UserForm1 の両方で試してみましたが、 どちらも結果は同じ。
▼プリント結果 ----------------------------------- fm.Show vbModeless 699299200 Print_Out End Sub 699299200 UserForm_Click 699299200 True after MsgBox 1 699299200 True OnTime printlog 0
▼プリント結果 ----------------------------------- fm.Show vbModeless 699299704 Print_Out End Sub 699299704 UserForm_Click 699299704 True after MsgBox 1 699299704 True OnTime printlog 0
UserForm_Clickによって[Print_Out]が実行され、 戻ってきて[MsgBox 1]が呼び出された後もまだインスタンスは生きてますね。
Application.OnTimeで確認したらObjPtrがゼロを返したので UserForm_ClickのEnd Sub後にユーザーフォームが消失している様です。
UserForm_QueryCloseもUserForm_Terminateもプリントされなかったので 何らかの命令によって閉じられた訳ではないものと思われます。 (↓は参考までにvbModalでShowした場合)
▼プリント結果 -----------------------------------
Print_Out End Sub 549917992
UserForm_Click 549917992 True
after MsgBox 1 549917992 True
OnTime printlog 549917992 ← ココね。ちゃんとオブジェクトは生きてます。
← ホントはここまで。↓その後ユーザーフォームを[×]で閉じた続きです
UserForm_QueryClose 549917992
UserForm_Terminate 549917992
fm.Show vbModeless 549917992 ← これはvbModalによって[test]内のDebug.Printが最後に回されただけ
では、いちばん怪しい[Print_Out]内5か所の「OLEObjects.Add...」の部分について...
●ClassType:="BARCODE.BarCodeCtrl.1"
から
ClassType:="Forms.Image.1"
に変更して実行...
↓
同じくユーザーフォームが消失
念の為、実行後に自動的に付くMSBCODE9.OCXへの参照設定を解いた上で実行しても同じ
[Print_Out]前に Me.Hide して実行後にMe.Show vbModeless としてもダメでした。
●OLEObjects.Addをすべてコメントアウトして実行
↓
これならユーザーフォームは表示されたまま。という結果でした。(まあ、予想通りというか...^^;)
OLEObjects.Addが原因なのであれば、 あらかじめ必要最大限のBarCodeCtrlを配置しておいて、 表示/非表示の切り替えで運用してみたらどうなんだろう? と思いましたが ちょっとそこまで試す気にはなれませんでした。
今回実験中に初めて使ってみて思ったんですけど なんせこのBarCodeCtrlってヤツ「重い」です。たくさん配置してあるとどんどん処理が遅くなる。orz
（白茶） 2023/05/24(水) 19:36:50
書き洩らし。
[Print_Out]のEnd Sub直前に↓入れて実験してます。(まあ分かったと思いますけど ^^;)
Debug.Print Now; "Print_Out End Sub", ObjPtr(fm)
あと、同じく[Print_Out]内の↓は一時的にコメントアウト。
' Application.EnableEvents = False
' Application.DisplayAlerts = False
' Application.ScreenUpdating = False
' Set xlApp = CreateObject("Excel.Application")
' With xlApp.Workbooks.Open(Mst_FlName, UpdateLinks:=False, ReadOnly:=False)
' .Range("O5").Value = UserForm1.Date_.Text
' All_Delete
' All_Delete
' Set xlApp = Nothing
' Application.EnableEvents = True
代わりに出だし部分に↓伝家の宝刀
On Error Resume Next
んで、 Str_IdhとStr_Lblはてきとうにシート2枚追加して動作確認しました。
（白茶） 2023/05/24(水) 20:00:18
少し不安になって追加で確認したところ、Endステートメントとの違いも見えました。
Endステートメント打った時は、 自プロジェクトはもちろん他プロジェクト上のPublic変数やStatic変数も初期化されてしまいますが、 今回の現象は他プロジェクト上の変数まで吹き飛ばしてしまう訳ではなさそうです。 但し、 自プロジェクト上のPublic変数、Static変数は、一連のマクロとは直接関係の無いモジュール上であろうが 中身が破棄されちゃってます。
あー...そういや、なんか思い出しました。
私もOLEObjects.Add以外で類似の現象は経験があります。Excel2003の頃ですけど。
複雑なセル範囲に対してClearContentsしたら、 あたかもEndステートメント打ったかの様にエラーも無くそこでマクロが終わったんですよね。 でも 同じセル範囲に対して「.Value = Empty」とすれば特に問題なく続行される。 んで、 セル範囲をArea単位に順番にClearContentsしてみたら、 条件付き書式を設定しているAreaに差し掛かったところでマクロが終わってる事が判明。
当時から自作アドインとか個人用マクロブック上でPublic変数使いまくってたけど そちらの挙動に不具合が伝播した記憶はないので、恐らく今回の現象と同じだと思います。 ちなみに私の場合は、 その後たまたまPCの買い替えに伴ってExcelがバージョンアップしたんですが、そしたら現象が発生しなくなりました。
（白茶） 2023/05/25(木) 09:37:17
教えてくださったように、あらかじめセルとリンクさせたBarCodeCtrlを配置させたら閉じることなく動きました！
OLEObjects.Addが原因だったとは気づきませんでした。。。
おまけにその後のStart_もエクセルが落ちてしまっていたのですが、この条件で同時に動かしたら、無事動いてくれました！！
正直自分の知識では絶対に思いつかないというか、出来ないやり方で原因の追跡をしていて言葉を失いました。。すごすぎです。。
白茶さんのおっしゃった事も調べながら何とか少し理解できた程度で、正直まだ全然完璧に理解できてませんが。。自分にとってもとてもいい勉強になりましたし、自分の未熟さを痛感して、今後ももっと勉強頑張っていこうと思いました！本当にありがとうございました！！
（初心者） 2023/05/25(木) 09:50:06
色々な経験談、すごく為になります。
正直自分はマクロ色々作っていて、動くけどそれに対して深く知っているわけではなかったので、今回の一軒で知識大事だなと改めて思いました(^^)
（初心者） 2023/05/25(木) 10:00:57
あ、そっか!
もっと端的に例えるならこれ、
「プチ・デザインモード化」してる現象という事なんじゃないでしょうかね。
...そんだけです。スマセン ^^;
（白茶） 2023/05/26(金) 17:05:51
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.