エクセルの学校：全文検索：Hyper Estraier：リスト

Results of 1 - 1 of about 8929 for リスト (0.007 sec.)

[[20181112232738]]: #score: 2746; @digest: b570019ec49a6d88cd266ecc9a02cd72; @id: 77816; @mdate: 2018-11-13T13:58:20Z; @size: 9859; @type: text/plain; #keywords: strselect (77059), strerror (52385), shcheck (43904), myerror (13969), selected (12485), listbox (10590), listcount (10208), listbox1 (6753), 同期 (6720), 択状 (6364), 在チ (5966), ト同 (5605), vbcrlf (4708), list (3791), 格納 (3271), リス (3068), 選択 (2936), 存在 (2930), preserve (2404), スト (2076), ト名 (2026), チェ (1810), シー (1641), ェッ (1639), エラ (1473), トリ (1446), ラー (1373), ート (1343), worksheets (1333), ッセ (1321), マイ (1316), メッ (1314); 『（マクロ）シートがない場合の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 ＞ ---- 回答ではなくて確認ですが、ListBoxは何処に配置してるのでしょうか? なんとなくユーザーフォーム上にありそうですが、その認識でよいです? （もこな2） 2018/11/13(火) 00:26 ---- もこな2さんユーザーフォームに配置しております。（マイン） 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 こんな感じにすれば、そもそもエラートラップしなくて良いのではないですか? （もこな2） 2018/11/13(火) 02:21 ---- もこな2 さん早朝からありがとうございます。コードまで提示していただき感謝します。フォーム起動段階でシート有無チェックも考えましたがあえて、リストにシート名を登録させて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 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/201811/20181112232738.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ