Excel VBA質問箱 IV

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

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


53891 / 76736 ←次へ | 前へ→

【27651】Re:ブックの新規作成とコピー
発言  ponpon  - 05/8/14(日) 23:41 -

引用なし
パスワード
   こんばんは。

できるだけ、提示のコードを生かすようにしました。
もっと良い方法があると思います。
試してください。

フォームモジュールに

Private Sub CommandButton1_Click()
   Dim myWB As Workbook
 
  Set myWB = Workbooks.Add
  If Me.CheckBox1.Value = True Then
    myWB.Sheets(1).Name = "データシート"
    Workbooks("作業報告書_保存.xls").Sheets("データシート").Cells.Copy _
                myWB.Sheets("データシート").Range("A1")
    Call 保存
  
  ElseIf Me.CheckBox2.Value = True Then
  

'   以下、同様にCheckBox2、CheckBox3、CheckBox4でシート2・3・4をコピーする
  End If
End Sub


標準モジュールに
Sub 保存()
  Dim savPath As Variant
  Dim fName As String
  Dim a As Integer, b As Integer
 

  Application.DisplayAlerts = False

'    savPath = Application.GetSaveAsFilename( _
'          InitialFileName:="作業報告書.xls", _
'              FileFilter:="Excelファイル (*.xls), *.xls,すべてのファイル(*.*),*.*")
     If UserForm1.TextBox1.Text <> "" Then
      savPath = UserForm1.TextBox1.Text & ".xls"
       fName = Dir(ThisWorkbook.Path & savPath)
 
      If fName <> "" Then
        a = MsgBox("同じ名前のファイルがあります。上書きしますか?", vbYesNoCancel)
        Select Case a
        Case 6 'OK
          ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & savPath
          Unload UserForm1
          ActiveWorkbook.Close
          Exit Sub
          
        Case 7 'NO
  
        Case 2 'Cancel
          Exit Sub
        End Select
       Else
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & savPath
        Unload UserForm1
        ActiveWorkbook.Close
        Exit Sub
       End If
     Else
      MsgBox "ファイル名がありません。"
      UserForm1.TextBox1.SetFocus
      Exit Sub
      
     End If

End Sub
0 hits

【27650】ブックの新規作成とコピー たかし 05/8/14(日) 22:09 質問
【27651】Re:ブックの新規作成とコピー ponpon 05/8/14(日) 23:41 発言
【27653】Re:ブックの新規作成とコピー Hirofumi 05/8/15(月) 3:12 回答
【27654】Re:ブックの新規作成とコピー たかし 05/8/15(月) 10:23 質問
【27656】Re:ブックの新規作成とコピー たかし 05/8/15(月) 10:34 質問
【27663】Re:ブックの新規作成とコピー Hirofumi 05/8/15(月) 12:43 回答
【27666】Re:ブックの新規作成とコピー たかし 05/8/15(月) 13:12 質問
【27667】Re:ブックの新規作成とコピー Hirofumi 05/8/15(月) 14:31 回答
【27669】Re:ブックの新規作成とコピー たかし 05/8/15(月) 15:03 お礼

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