Excel VBA質問箱 IV

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

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


53888 / 76732 ←次へ | 前へ→

【27650】ブックの新規作成とコピー
質問  たかし  - 05/8/14(日) 22:09 -

引用なし
パスワード
   お世話になってます。
今回は、ブックを新規に作成し、元のブックのシートをコピーするマクロを作成しました。
そこで、いくつか思うように動作しない箇所があります。
どなたかいいアドバイスをいただけないでしょうか?
過去ログからいろいろ調べて、ここまでは作成してみましたが、うまくいきません。
よろしくお願いします。

1. ユーザーフォーム上に、保存用のファイル名を決めるTextboxがあります。
2. コピーするシートを決定するためのCheckboxが4つあります。
3. 実行するためのCommandbuttonがあります。

問題1
Textbox1の内容が、名前をつけて保存のファイル名に反映する方法が分かりません。
いい方法があれば、教えてください。

問題2
どうも、コピーされていません。というか、元ファイルのファイル名が変更されているだけ
のような気がします。
どうすれば良いでしょうか?


マクロ
Private Sub CommandButton1_Click()
  Dim savPath As Variant
  Dim fName As String
  Dim a As Integer, b As Integer
 
 Workbooks.Add

 Application.DisplayAlerts = False

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

 If CheckBox1 = ture Then
  Windows("作業報告書_保存.xls").Activate
  Sheets("データシート").Select
  Cells.Copy
  Windows("Book1").Activate
  Sheets("Sheet1").Select
  Sheets.Add.Name = "データシート"
  Cells.Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
  Range("A1").Select
 Else
  If CheckBox2 = ture Then

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

よろしくお願いします。

2 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 お礼

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