Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10216 / 76734 ←次へ | 前へ→

【72068】Re:検索コード
発言  UO3  - 12/5/24(木) 23:19 -

引用なし
パスワード
   ▼VBA初心者 さん:

コード案提示に加えて上でいくつか質問しています。
その中で "シートを選択" するのはなぜ? というのがあったかと思います。
要は該当のシートを、確認の上印刷すればいいんですね?
シートを、ことさら選択する必要はありませんね。

提示済みのものを、ほぼそのまま使っています。
ユーザーフォームモジュールに。

Private Sub CommandButton1_Click()
  Dim sh As Worksheet
  Dim shN As Variant
  Dim shV() As String
  Dim k As Long
  Dim f As Double, t As Double, n As Double
  Dim s1 As String, s2 As String
  Dim ok As Boolean
 
  s1 = TextBox1.Value
  s2 = TextBox2.Value
  
  If Len(s1) = 0 Or Len(s2) = 0 Then
    MsgBox "シート 開始/終了を入力してから実行してください"
    Exit Sub
  End If
  
  f = getValue(s1)
  If f Then
    t = getValue(s2)
    If t Then ok = True
  End If
   
  If Not ok Then
    MsgBox "シート範囲を正しく指定してください"
    Exit Sub
  End If
 
  ReDim shV(1 To Worksheets.Count)
 
  For Each sh In Worksheets
    n = getValue(sh.Name)
    If n >= f And n <= t Then
      k = k + 1
      shV(k) = sh.Name
    End If
  Next
 
  If k = 0 Then
    MsgBox "該当のシートがありません"
    Exit Sub
  End If
 
  ReDim Preserve shV(1 To k)
 
  If MsgBox("以下のシートが選ばれました。印刷してよろしいですか?" & vbLf & _
    Join(shV, vbLf), vbYesNo) = vbNo Then Exit Sub
  
  For Each shN In shV
    Sheets(shN).PrintOut
  Next
   
End Sub

Private Function getValue(ByVal s As Variant) As Double
  Dim wk As Variant
 
  s = LCase(StrConv(s, vbNarrow))
  wk = Split(s, "k")
  If UBound(wk) = 1 Then
    getValue = Val(wk(0)) + Val(wk(1)) / 1000
  End If

End Function
4 hits

【72053】検索コード VBA初心者 12/5/22(火) 20:43 質問
【72056】Re:検索コード UO3 12/5/23(水) 9:47 発言
【72057】Re:検索コード UO3 12/5/23(水) 9:51 発言
【72058】Re:検索コード UO3 12/5/23(水) 10:25 発言
【72059】Re:検索コード UO3 12/5/23(水) 11:00 発言
【72067】Re:検索コード VBA初心者 12/5/24(木) 22:44 質問
【72068】Re:検索コード UO3 12/5/24(木) 23:19 発言
【72069】Re:検索コード UO3 12/5/24(木) 23:28 発言
【72070】Re:検索コード UO3 12/5/24(木) 23:39 発言
【72072】Re:検索コード UO3 12/5/25(金) 6:32 発言

10216 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free