| |
お世話になってます。
今回は、ブックを新規に作成し、元のブックのシートをコピーするマクロを作成しました。
そこで、いくつか思うように動作しない箇所があります。
どなたかいいアドバイスをいただけないでしょうか？
過去ログからいろいろ調べて、ここまでは作成してみましたが、うまくいきません。
よろしくお願いします。
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でシート２・３・４をコピーする
End If
End If
End Sub
よろしくお願いします。
|
|
たかし
- 05/8/14(日) 22:09 -
