pkh4989 の回答履歴

初めまして。 私はWindowsXP、Excel2003のVBAでシートの保護、またそれの解除のコードを組んだのですが、以下のコードでは「○○○と言う名前で保存します。よろしければこのままOKをクリックしてください」の箇所でキャンセルを選択した時に、シートの保護を行いたいのですが、どのようなコードにすればよいてのでしょうか？ 例） 　 Dim FileName As String Dim FileExt As String Dim BkName1 As String Dim BkName2 As String Dim BkName3 As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "適材適所グラフ" Const StName2 As String = "適材適所回答" Const StName3 As String = "適性検査III回答" Const StName4 As String = "適性検査IIIグラフ" 'シートの保護を解除 Worksheets("適性検査III回答").Unprotect Worksheets("適材適所回答").Unprotect Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName1 = OldWkbook.Sheets(StName3).Range("L1").Value BkName2 = OldWkbook.Sheets(StName3).Range("L2").Value BkName3 = OldWkbook.Sheets(StName3).Range("L3").Value FileName = BkName1 & Format(".") & BkName2 & Format(".") & BkName3 & ".xls" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".xls" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If OldWkbook.Sheets(Array(StName1, StName2, StName3, StName4)).Copy Set NewWkbook = ActiveWorkbook 'ボタンを削除 For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete End If Next NewWkbook.Sheets(1).Name = StName1 'コピー先シートの保護 Sheets(1).Protect Sheets(2).Protect Sheets(3).Protect Sheets(4).Protect FileName = "C:\採点結果\" & FileName If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub '##指定ファイル置き換え保存 End If NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If NewWkbook.Close savechanges:=False Application.DisplayAlerts = True 'シートの保護 Worksheets("適性検査III回答").Protect Worksheets("適材適所回答").Protect End Sub

こんにちわ。 Excel2003のVBAで、シート1に採点用のフォーマットを作成し、採点ボタンを押したら別の場所（フォルダ）に別のファイル（.xls形式）として採点結果を保存したいと考えています。過去に似たような質問があったのでそれを参考にしたのですが、コードの意味がほとんど分かりません。下記のコードで実行したところ、エラーが出てしまいます。どこが悪いのか教えていただけないでしょうか？ エラー箇所は BkName = OldWkbook.Sheets(StName1).Range("K1").Value です。”インデックスが有効範囲にありません”と表示されます。 例） 　 Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "ko" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("K1").Value FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook 'シートの保護を解除 Worksheets("sheet1").Unprotect For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete '←1ではなくwIxです End If Next NewWkbook.Sheets(1).Name = StName1 ' FileName = "D:\保存\計画\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

Bookには一か月分のシート（9.1　9.2　・・・)が存在します。表はB4：AY43の大きさで、各シート共通で行15行目と34行目に「10桁の受注番号」を入力すのですが、この「受注番号」は絶対重複してはいけないコードになっています。当該各セルに受注番号を入力した時に、同シート及び他のシートに同じ番号が存在しないか判別し、存在しなければそのまま入力し、重複している時はメッセージで警告し入力した番号を一旦クリアーするにはどのようにすればよいでしょうか。宜しくお願い致します。

Bookには一か月分のシート（9.1　9.2　・・・)が存在します。表はB4：AY43の大きさで、各シート共通で行15行目と34行目に「10桁の受注番号」を入力すのですが、この「受注番号」は絶対重複してはいけないコードになっています。当該各セルに受注番号を入力した時に、同シート及び他のシートに同じ番号が存在しないか判別し、存在しなければそのまま入力し、重複している時はメッセージで警告し入力した番号を一旦クリアーするにはどのようにすればよいでしょうか。宜しくお願い致します。

Bookには一か月分のシート（9.1　9.2　・・・)が存在します。表はB4：AY43の大きさで、各シート共通で行15行目と34行目に「10桁の受注番号」を入力すのですが、この「受注番号」は絶対重複してはいけないコードになっています。当該各セルに受注番号を入力した時に、同シート及び他のシートに同じ番号が存在しないか判別し、存在しなければそのまま入力し、重複している時はメッセージで警告し入力した番号を一旦クリアーするにはどのようにすればよいでしょうか。宜しくお願い致します。

現在VBとVBAの勉強をしているのですが、VB6.0からエクセルを起動する際に、エクセルにはVB6.0から引数を渡したいのですがどうすれば良いでしょうか？ どなたか、ご存じの方が居ましたら教えてください。

エクセルで sheet1このように入力されております。 A列には製造番号　Ｂ列には日付　Ｃ列単価　Ｄ列記号がすでに入力済みです。 _____________________________________ 行/列　 A 　　 B 　　 C 　　 D 1 　 123456 　 4/5 　 1020 　 K 2　　789456　 5/2 　 500 　　D 3　　789789 　 6/2 　 9000 　 F 4　　456789 　 6/2 　 5000 　 S ------------------------------------- sheet2には製造番号が500行ランダムに入力済みです。 _____________________________________ 行/列　 d 　　 E 　　 F 　　 G 2 　 456789 3　　789456　 4　　789789 5　　456789 6 　　 ： 7　　　： ------------------------------------- ボタンをおしたら一致した製造番号のEFG列にsheet1の日付・単価・記号を自動的に入力したい。どなたかご教授お願いいたします。

こんにちわ。 Excel2003のVBAで、シート1に採点用のフォーマットを作成し、採点ボタンを押したら別の場所（フォルダ）に別のファイル（.xls形式）として採点結果を保存したいと考えています。過去に似たような質問があったのでそれを参考にしたのですが、コードの意味がほとんど分かりません。下記のコードで実行したところ、エラーが出てしまいます。どこが悪いのか教えていただけないでしょうか？ エラー箇所は BkName = OldWkbook.Sheets(StName1).Range("K1").Value です。”インデックスが有効範囲にありません”と表示されます。 例） 　 Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "ko" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("K1").Value FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook 'シートの保護を解除 Worksheets("sheet1").Unprotect For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete '←1ではなくwIxです End If Next NewWkbook.Sheets(1).Name = StName1 ' FileName = "D:\保存\計画\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

こんにちわ。 Excel2003のVBAで、シート1に採点用のフォーマットを作成し、採点ボタンを押したら別の場所（フォルダ）に別のファイル（.xls形式）として採点結果を保存したいと考えています。過去に似たような質問があったのでそれを参考にしたのですが、コードの意味がほとんど分かりません。下記のコードで実行したところ、エラーが出てしまいます。どこが悪いのか教えていただけないでしょうか？ エラー箇所は BkName = OldWkbook.Sheets(StName1).Range("K1").Value です。”インデックスが有効範囲にありません”と表示されます。 例） 　 Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "ko" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("K1").Value FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook 'シートの保護を解除 Worksheets("sheet1").Unprotect For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete '←1ではなくwIxです End If Next NewWkbook.Sheets(1).Name = StName1 ' FileName = "D:\保存\計画\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

こんにちわ。 Excel2003のVBAで、シート1に採点用のフォーマットを作成し、採点ボタンを押したら別の場所（フォルダ）に別のファイル（.xls形式）として採点結果を保存したいと考えています。過去に似たような質問があったのでそれを参考にしたのですが、コードの意味がほとんど分かりません。下記のコードで実行したところ、エラーが出てしまいます。どこが悪いのか教えていただけないでしょうか？ エラー箇所は BkName = OldWkbook.Sheets(StName1).Range("K1").Value です。”インデックスが有効範囲にありません”と表示されます。 例） 　 Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "ko" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("K1").Value FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook 'シートの保護を解除 Worksheets("sheet1").Unprotect For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete '←1ではなくwIxです End If Next NewWkbook.Sheets(1).Name = StName1 ' FileName = "D:\保存\計画\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

Dim i As Long Dim k As Long For i = 1 To 829 For k = 1 To 995 Worksheets("2").Cells(k,i) = Worksheets("1").Cells(k,i) /Worksheets("1").Cells(996,i) Next k Next i これを実行したらオーバーフローしてしまい、途中までしか計算できませんでした。 解決方法を教えて頂きたいです。よろしくお願いします。

エクセルでIF式を使っています。 列を増やす必要があったので増やしたところ計算式がエクセルの計算式を一回見てエンターを押さないと計算されなくなりました。 原因がよくわかりません。 この文面ではわかりにくいと思いますが誰かわかる方教えてください。 よろしくお願いします。

エクセルVBAで文字列を検索して、検索した文字列を他のセルへ出力する方法を探しております。状況を図で説明すると、 A1セル：aaa\bbb\item1\ddd A2セル：aaa\bbb\ccc\item2\ddd A3セル：aaa\bbb\ccc\ddd\item3\eee このような状態からitemを検索して、B1セルに B1セル：item1 B2セル：item2 B3セル：item3 と表示させたいです。エクセルVBA初心者なものでRegExpを使うのかな、というところまではたどり着きましたが、そこから先にすすめません。 何か良い方法をご存知の方、教えていただきたいです。よろしくお願いいたします。

Excel2003を使用しております。 特定の行（例えばB行で列番号は問わない）にアクティヴセルが あり、左矢印キーを押した時マクロを実行したいのですが 条件文になんと書いて良いか分かりません。 また、その行のときのみ左矢印キーを押しても隣の行 （B行にアクティブセルがあるなら、A行）に移動しないようにしたいのですが、どのようにすればよいのか教えていただけませんでしょうか？ よろしくお願い致します。

EXCELのVBAを使って経費の打ち込みをするマクロを作っています その中で、コンボボックスで日付を選択するようにしました コンボボックスに表示する日付はセルから「RowSource」で取り出しました セルの日付の入力形式は「2008/10/1」です そのセルの書式設定で表示形式を「ユーザー定義で d (日だけ表示)」としています なので、コンボボックスで選択して表示する際も日だけを表示したいのですがうまくいきません ComboBox1 = Format(ComboBox1, "d") とすると、コンボボックス内で数字がちらちらしてランダムに数字が表示されてしまいます ComboBox1 = Format(ComboBox1, "m月d日") この形だと、きちんと「10月1日」の様に表示されます Private Sub UserForm_Initialize() With ComboBox1 .RowSource = "sheet1!A1:A5"　'日付のセル End With End Sub Private Sub ComboBox1_Change() ComboBox1 = Format(ComboBox1, "m月d日") End Sub 日だけを表示する方法をご教授ください

いつも参考にさせていただいております。 現在データベースからデータを取ってきてFlexgridに表示するプログラムを作りました。 そのフォームでFlexgridのある行を選択して削除ボタンを押すと、Flexgridの選択した行とデータベースのIDと一致した行を削除するようにしたいと思っています。 しかし、データベースの削除を行うためにFlexgridの選択した行のID列の値を取得しなければならないと思うのですが、どうやって取得すればよいのか分かりません。 どのようにすればよいでしょうか？ サンプルなどあればよろしくお願いいたします。 ID　　名前　　部 ------------------ 01　　佐藤　　野球 02　　鈴木　　サッカー　　←例えばこの行を選択したら02を抜き出したい 03　　田中　　剣道 04　　山田　　柔道 05　　高橋　　バレー 環境：Window XP Pro、FlexGrid for .NET 4.0J、SQL Server 2005

Sheet上にボタンを作成 ボタンを押すと保存するようにしています！ 以前ここでSheet2枚をコピー出来るような 記述教えてもらったのですが・・ 1枚ならどう変化して良いか・・ 記述を書きましたが 何処が違うか教えて下さい！ Private Sub CommandButton1_Click() 　　Dim FileName　　As String 　　Dim FileExt　　 As String 　　Dim BkName　　　As String 　　Dim OldWkbook　 As Workbook 　　Dim NewWkbook　 As Workbook 　　Const StName1　 As String = "ko" 　　 　　' 　　Application.DisplayAlerts = False 　　Set OldWkbook = ActiveWorkbook 　　' 　　'ファイル名を取得 　　BkName = OldWkbook.Sheets(StName1).Range("A1").Value 　　FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" 　　' 　　FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) 　　If FileName = "" Then 　　　　Exit Sub 　　Else 　　　　If Right(FileName, 4) <> ".XLS" Then 　　　　　　MsgBox "ファイル名が異常です。" 　　　　　　Exit Sub 　　　　End If 　　End If 　　' 　　OldWkbook.Sheets(Array(StName1)).Copy 　　Set NewWkbook = ActiveWorkbook 　　For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count 　　　　NewWkbook.Sheets(1).Shapes(wIx).Delete　 　　Next 　　NewWkbook.Sheets(1).Name = StName1 　　' 　　FileName = "D:\保存\計画\" & FileName 　　' 　　If Dir(FileName) <> "" Then 　　　　'##ファイルが既に存在する 　　　　If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then 　　　　　　NewWkbook.Close savechanges:=False 　　　　　　'##保存せずに終了 　　　　　　Exit Sub 　　　　End If 　　　　'##指定ファイル置き換え保存 　　　　NewWkbook.SaveAs FileName:=FileName 　　Else 　　　　'##ファイルを新規保存 　　　　NewWkbook.SaveAs FileName:=FileName 　　End If 　　' 　　NewWkbook.Close savechanges:=False 　　Application.DisplayAlerts = True End Sub 教えて下さい！

Sheet上にボタンを作成 ボタンを押すと保存するようにしています！ 以前ここでSheet2枚をコピー出来るような 記述教えてもらったのですが・・ 1枚ならどう変化して良いか・・ 記述を書きましたが 何処が違うか教えて下さい！ Private Sub CommandButton1_Click() 　　Dim FileName　　As String 　　Dim FileExt　　 As String 　　Dim BkName　　　As String 　　Dim OldWkbook　 As Workbook 　　Dim NewWkbook　 As Workbook 　　Const StName1　 As String = "ko" 　　 　　' 　　Application.DisplayAlerts = False 　　Set OldWkbook = ActiveWorkbook 　　' 　　'ファイル名を取得 　　BkName = OldWkbook.Sheets(StName1).Range("A1").Value 　　FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" 　　' 　　FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) 　　If FileName = "" Then 　　　　Exit Sub 　　Else 　　　　If Right(FileName, 4) <> ".XLS" Then 　　　　　　MsgBox "ファイル名が異常です。" 　　　　　　Exit Sub 　　　　End If 　　End If 　　' 　　OldWkbook.Sheets(Array(StName1)).Copy 　　Set NewWkbook = ActiveWorkbook 　　For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count 　　　　NewWkbook.Sheets(1).Shapes(wIx).Delete　 　　Next 　　NewWkbook.Sheets(1).Name = StName1 　　' 　　FileName = "D:\保存\計画\" & FileName 　　' 　　If Dir(FileName) <> "" Then 　　　　'##ファイルが既に存在する 　　　　If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then 　　　　　　NewWkbook.Close savechanges:=False 　　　　　　'##保存せずに終了 　　　　　　Exit Sub 　　　　End If 　　　　'##指定ファイル置き換え保存 　　　　NewWkbook.SaveAs FileName:=FileName 　　Else 　　　　'##ファイルを新規保存 　　　　NewWkbook.SaveAs FileName:=FileName 　　End If 　　' 　　NewWkbook.Close savechanges:=False 　　Application.DisplayAlerts = True End Sub 教えて下さい！

Sheet上にボタンを作成 ボタンを押すと保存するようにしています！ 以前ここでSheet2枚をコピー出来るような 記述教えてもらったのですが・・ 1枚ならどう変化して良いか・・ 記述を書きましたが 何処が違うか教えて下さい！ Private Sub CommandButton1_Click() 　　Dim FileName　　As String 　　Dim FileExt　　 As String 　　Dim BkName　　　As String 　　Dim OldWkbook　 As Workbook 　　Dim NewWkbook　 As Workbook 　　Const StName1　 As String = "ko" 　　 　　' 　　Application.DisplayAlerts = False 　　Set OldWkbook = ActiveWorkbook 　　' 　　'ファイル名を取得 　　BkName = OldWkbook.Sheets(StName1).Range("A1").Value 　　FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" 　　' 　　FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) 　　If FileName = "" Then 　　　　Exit Sub 　　Else 　　　　If Right(FileName, 4) <> ".XLS" Then 　　　　　　MsgBox "ファイル名が異常です。" 　　　　　　Exit Sub 　　　　End If 　　End If 　　' 　　OldWkbook.Sheets(Array(StName1)).Copy 　　Set NewWkbook = ActiveWorkbook 　　For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count 　　　　NewWkbook.Sheets(1).Shapes(wIx).Delete　 　　Next 　　NewWkbook.Sheets(1).Name = StName1 　　' 　　FileName = "D:\保存\計画\" & FileName 　　' 　　If Dir(FileName) <> "" Then 　　　　'##ファイルが既に存在する 　　　　If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then 　　　　　　NewWkbook.Close savechanges:=False 　　　　　　'##保存せずに終了 　　　　　　Exit Sub 　　　　End If 　　　　'##指定ファイル置き換え保存 　　　　NewWkbook.SaveAs FileName:=FileName 　　Else 　　　　'##ファイルを新規保存 　　　　NewWkbook.SaveAs FileName:=FileName 　　End If 　　' 　　NewWkbook.Close savechanges:=False 　　Application.DisplayAlerts = True End Sub 教えて下さい！

Sheet上にボタンを作成 ボタンを押すと保存するようにしています！ 以前ここでSheet2枚をコピー出来るような 記述教えてもらったのですが・・ 1枚ならどう変化して良いか・・ 記述を書きましたが 何処が違うか教えて下さい！ Private Sub CommandButton1_Click() 　　Dim FileName　　As String 　　Dim FileExt　　 As String 　　Dim BkName　　　As String 　　Dim OldWkbook　 As Workbook 　　Dim NewWkbook　 As Workbook 　　Const StName1　 As String = "ko" 　　 　　' 　　Application.DisplayAlerts = False 　　Set OldWkbook = ActiveWorkbook 　　' 　　'ファイル名を取得 　　BkName = OldWkbook.Sheets(StName1).Range("A1").Value 　　FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" 　　' 　　FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) 　　If FileName = "" Then 　　　　Exit Sub 　　Else 　　　　If Right(FileName, 4) <> ".XLS" Then 　　　　　　MsgBox "ファイル名が異常です。" 　　　　　　Exit Sub 　　　　End If 　　End If 　　' 　　OldWkbook.Sheets(Array(StName1)).Copy 　　Set NewWkbook = ActiveWorkbook 　　For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count 　　　　NewWkbook.Sheets(1).Shapes(wIx).Delete　 　　Next 　　NewWkbook.Sheets(1).Name = StName1 　　' 　　FileName = "D:\保存\計画\" & FileName 　　' 　　If Dir(FileName) <> "" Then 　　　　'##ファイルが既に存在する 　　　　If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then 　　　　　　NewWkbook.Close savechanges:=False 　　　　　　'##保存せずに終了 　　　　　　Exit Sub 　　　　End If 　　　　'##指定ファイル置き換え保存 　　　　NewWkbook.SaveAs FileName:=FileName 　　Else 　　　　'##ファイルを新規保存 　　　　NewWkbook.SaveAs FileName:=FileName 　　End If 　　' 　　NewWkbook.Close savechanges:=False 　　Application.DisplayAlerts = True End Sub 教えて下さい！