[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『（マクロ）シートがない場合のError処理』（マイン）
いつもお世話になっております。
ListBox1とWorksheetを同期させ一括印刷するコードを作成しております。
処理の概要は・・・
・セルにSheet名を入力したリスト表をListBox1に読み込みます（複数列表示）
↓
・ListBox1を選択（複数選択可）すると実際のWorksheetを選択状態にします。
↓
・選択されたWorksheetを一括で印刷処理します
といったものです。
質問の内容は「エラー処理」です。
下記コード記述方法が間違っているのか
On Error GoTo myError
・
・
myError:
実在するシートを適正に処理された状態で
エラー番号:" & Err.Number &→エラー番号9がでます。
もちろん、実在しないシートがあっても同様の症状となります。
コード全体がおかしいのか、エラーコードの記述方法がおかしいのか
どうも分からなくなり質問させていただきました。
どうかアドバイスの程よろしくお願い致します。
（実行パーツ部分）
Private Sub TextBox_w1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'メッセージ表示し実行するか選択
If MsgBox("担当者の「 " & TextBox_w1.Text & " 」分の記録を印刷しますか？" _
, Buttons:=vbYesNo + vbQuestion, Title:="確認！") = 6 Then
'★同期と印刷処理
Call シートリスト同期
Else
'★キャンセル時はココに飛ぶ
MsgBox "キャンセル"
End If
End Sub
（処理パーツ部分）
・複数選択可能なListBoxから、リスト=シート名を選択するとWorksheetを同時に選択状態
・選択したリスト=シート名が実際にWorksheetに存在しなかったらError処理
Private Sub シートリスト同期()
Dim List選択 As Boolean 'List選択ﾁｪｯｸ
Dim i As Long 'カウンター
Dim j As Long 'リスト内の行
Dim strSelect() As String 'リスト内の取得した値を格納
With ListBox1
'★リストを選択しているかチェック
'（注）ListBoxがMultiSelectの場合はループで選択状況を取得しなければならない
For i = 1 To .ListCount
'1行づつチェック
List選択 = .Selected(i - 1)
Next i
'リスト未選択の場合→メッセージ→終了
If Not List選択 Then
MsgBox "担当者を選択してください"
Exit Sub
End If
'（エラー時は､下のとび位置まで飛んで途中のコードは省く）
On Error GoTo myError
'★ループチェックしてListが選択状態であれば下記処理
'Listbox1のリストを選択すると連動して該当するシートを選択
j = -1
For i = 0 To .ListCount - 1 'List内のリスト数分ループ
If .Selected(i) Then '選択行ならば
'リスト項目の取得
j = j + 1
ReDim Preserve strSelect(j)
strSelect(j) = .List(i, 1) 'List値の取得箇所（行,列）
End If
Next i
If j > -1 Then '格納値があれば
'リスト名と同じシート名を選択する
Worksheets(strSelect).Select
End If
'★個人記録に日付を転記
For i = 0 To .ListCount - 1
If .Selected(i) Then
'テキストボックス6に表示されている日付情報を記録表の日付欄へ書き込む
Worksheets(.List(i)).Range("C4").Value = Worksheets("設定").Range("A3").Value
MsgBox "印刷" 'ダミー
End If
Next
End With
'（エラーがない場合正常終了）
Exit Sub
'（エラー時はココに飛ぶ）
myError:
'★エラーメッセージ：リストに無いシート名選択時
Worksheets("リスト").Select
MsgBox _
"（エラー番号:" & Err.Number & "） 記録表が見つかりません" & vbCrLf & vbCrLf & _
" 選択された記録表Sheetを確認し再度実行してください" & vbCrLf & " " & vbCrLf & _
"（確認）" & vbCrLf & " " & vbCrLf & _
" ワークシート名に空白スペースがあれば削除してください"
'（エラー処理設定を解除）
On Error GoTo 0
End Sub
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
（もこな２） 2018/11/13(火) 00:26
ユーザーフォームに配置しております。
（マイン） 2018/11/13(火) 00:51
Private Sub UserForm_Initialize()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
UserForm1.ListBox1.AddItem (SH.Name)
Next
End Sub
とすれば、ユーザーフォームをロードするときにリストボックスに実際に存在するシートだけの一覧は読み込めますよね。
そのうえで、コマンドボタン押したら選択したシートだけ印刷すればいいんだったら
Private Sub CommandButton1_Click()
Dim buf As String
Dim i As Long
For i = 0 To Me.ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then buf = buf & Me.ListBox1.List(i) & vbCrLf
Next i
If buf = "" Then
MsgBox "シートが選択されていません"
Exit Sub
End If
If MsgBox("以下のシートを印刷してよろしいですか" & vbCrLf & buf, vbYesNo) = vbYes Then
For i = 0 To Me.ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then Worksheets(i + 1).PrintPreview
Next
End If
End Sub
こんな感じにすれば、そもそもエラートラップしなくて良いのではないですか？
（もこな２） 2018/11/13(火) 02:21
早朝からありがとうございます。
コードまで提示していただき感謝します。
フォーム起動段階でシート有無チェックも考えましたが
あえて、リストにシート名を登録させてListBoxに読み込み
使用者に目視確認させる意図で作成しております。
シート名に
空白を入れずに項目を入力させるのですが中には空白を入れてしまう人もいるためです。
→シート名入力時に空白チェックはしていません。
あえて、リストに登録されたものをListBoxから参照チェックする形を取っています。
説明不足でお手間とらせましたことお詫びします。
（マイン） 2018/11/13(火) 09:07
Function shCheck(name As String)
でシートの存在有無を確認し
If Not (shCheck(strSelect(j))) Then
で存在しないシートを格納し
For ii = LBound(strError) To UBound(strError)
でメッセージボックスに存在しないシートを書き出す
このような流れで作成しました。
おかしな点があればご指摘をいただくと幸いです。
' 指定した名前のシートが存在するか確認します。
Function shCheck(name As String)
Dim wsh As Worksheet
On Error Resume Next
Set wsh = ThisWorkbook.Worksheets(name)
If (wsh Is Nothing) Then
shCheck = False '存在しない
Else
Set wsh = Nothing
shCheck = True '存在する
End If
End Function
'処理
Private Sub シートリスト同期()
Dim List選択 As Boolean 'List選択ﾁｪｯｸ
Dim j As Long 'ListBox内の値をReDim Preserveで追加
Dim i As Long 'ListBox用カウンター
Dim ii As Long 'Sheetエラー用カウンター
Dim msg As String 'Sheetエラー用
Dim strError() As String 'Sheetエラー値を格納
Dim strSelect() As String 'ListBox内の値を格納
Dim jj As Long 'Sheetエラー値をReDim Preserveで追加
With ListBox1
'★リストを選択しているかチェック------------------------------
'（注）ListBoxがMultiSelectの場合はループで選択状況を取得しなければならない
For i = 1 To .ListCount
'1行づつチェック
List選択 = .Selected(i - 1)
Next i
'リスト未選択の場合→メッセージ→終了
If Not List選択 Then
MsgBox "担当者を選択してください"
Exit Sub
End If
'★Listが選択状態であれば下記処理
j = -1 'ListBox内で選択された項目
jj = -1 'ListBox内の存在しないSheet抽出
For i = 0 To .ListCount - 1 'List内のリスト数分ループ
If .Selected(i) Then '選択行ならば
'リスト項目の取得と格納
j = j + 1
ReDim Preserve strSelect(j)
strSelect(j) = .List(i, 1) 'List値（行,列）=シート名取得
'★シート存在チェック（Function shCheck参照）-------------
If Not (shCheck(strSelect(j))) Then
'エラーSheet名取得と格納
jj = jj + 1
ReDim Preserve strError(jj)
strError(jj) = strSelect(j)
End If
'-------------------------------------------------
End If
Next i
'★シート存在チェック（存在なし：メッセージ表示とExit Sub）------------
If jj > -1 Then
'★格納された値を msg に配列の中身を連結しながら格納
For ii = LBound(strError) To UBound(strError)
msg = msg & strError(ii) & vbCrLf
Next ii
MsgBox "【選択された記録が見つかりません】" & vbCrLf & "リストとシート名を確認してください" & vbCrLf & vbCrLf & msg
Exit Sub
End If
'-------------------------------------------------
'★格納したシート名を選択し形成処理
If j > -1 Then '格納値があれば
'リスト名と同じシート名を選択する
Worksheets(strSelect).Select
End If
'★選択状態にあるシートセルに日付を転記
For i = 0 To .ListCount - 1
If .Selected(i) Then
'設定シートのセル値を記録シートへ書き込む
Worksheets(.List(i, 1)).Range("C4").Value = Worksheets("設定").Range("A3").Value
MsgBox "印刷" 'ダミー
End If
Next
End With
End Sub
（マイン） 2018/11/13(火) 19:55
いろいろ修正を加えてなんとかできました。
解決です(^o^)
（マイン） 2018/11/13(火) 22:58
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.