• 締切済み

プログラムの手直しを手伝って頂けないでしょうか?

した記載のサンプルプログラムの手直しを手伝って頂けないでしょうか? どうしても以下の問題が克服できずに困っています。 宜しくお願い致します。 ※コピー元を非表示にしてVBAでコピーすると、設定していた印刷範囲がリセットされるのを回避したい。 ※コピーしたワークシートを最後(右側)に置きたい。 ※コピーしたワークシート名を日付(201408XX)としたい。  同日にワークシートをもう一枚コペーした場合は(201408XX_(1))とかにしてエラー回避をしたい。 Sub サンプル() ' Dim sc As Integer ' sc = Application.SheetsInNewWorkbook ' Application.SheetsInNewWorkbook = 1 ThisWorkbook.Sheets("オリジナル").Cells.Copy 'コピー With Worksheets.Add 'シート追加 .Range("A1").PasteSpecial Paste:=xlValues '値貼り付け .Range("A1").PasteSpecial Paste:=xlFormats '書式貼り付け .Name = "コピー" End With Application.CutCopyMode = False ' Application.SheetsInNewWorkbook = sc ' ActiveWorkbook.Close ' ThisWorkbook.Activate End Sub

みんなの回答

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.2

#1、cjです。#1にて訂正が1点。 誤) On erro GoTo 0 ' ◆ 正) On Error GoTo 0 ' ◆ 以上訂正をお願いします。 投稿前に動作確認したコードでは正しく書かれていたのですが、 投稿文を編集する際に何らかの原因で書き換えてしまったようです。 今日になって再度、意地悪な条件を加えて動作確認してみましたが、 上記修正を加えれば、私が理解するところの要求仕様に適う動作結果は得られています。 余計なお手間をおかけしてスミマセン。 尚、提示した処理の前後に、他の処理を書き足す場合は、 Dim sShName As String  の次の行位置に挿入 Exit Sub  の前の行位置に挿入 という要領になります。 以上、失礼しました。

すると、全ての回答が全文表示されます。
  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.1

こんにちは。 Worksheets.Add 部分も統一して ThisWorkbook.Worksheets.Add にした方がいい場合もあるし、 実は(ThisWorkbook以外の)アクティブブックにコピーしたい等そのままでいい場合もあるのかも知れませんし、 この点はそちらで確認してみてください。 一般的には、 ThisWorkbook.Sheets("オリジナル")をWorksheet型変数にSetするとか、   With ThisWorkbook.Sheets("オリジナル") 文字列型変数 = .PageSetup.PrintArea     .Cells.Copy 'コピー   End With のように文字列型変数に必要な値を格納しておくとか、 の方が正当ですが、 そこまで重要では(優先されることではあり)ありませんし、 解り易さ(変更点)を強調する意味で ThisWorkbook.Sheets("オリジナル")を繰り返し書いています。    ◆のアイコンで示した行は、 > 同日にワークシートをもう一枚コペーした場合は(201408XX_(1))とかにしてエラー回避をしたい に対応する為に追加(書換え)した記述です。 同日のワークシートコピーは(あっても)少量と見込んで、一番簡単な方法で対策しています ' ' /// Sub Re8730357() Dim sShName As String ' ◆ 同日にワークシートをもう一枚コペーした場合は(201408XX_(1))とかにしてエラー回避をしたい。   ThisWorkbook.Sheets("オリジナル").Cells.Copy 'コピー   ' ' ※コピーしたワークシートを最後(右側)に置きたい   With Worksheets.Add(After:=Sheets(Sheets.Count)) 'シート追加     .Range("A1").PasteSpecial Paste:=xlValues '値貼り付け     .Range("A1").PasteSpecial Paste:=xlFormats '書式貼り付け     sShName = Format(Date, "yyyymmdd") ' ◆ On Error GoTo ReName_ ' ◆     ' ' ※コピーしたワークシート名を日付(201408XX)としたい。     .Name = sShName ' ◆ On erro GoTo 0 ' ◆     ' ' ※コピー元を非表示にしてVBAでコピーすると、設定していた印刷範囲がリセットされるのを回避したい。     ' ' 新しいシートの印刷範囲を設定する必要がある→.PageSetup.PrintAreaをコピーする。     .PageSetup.PrintArea = ThisWorkbook.Sheets("オリジナル").PageSetup.PrintArea   End With   Application.CutCopyMode = False Exit Sub ' ◆ ReName_: ' ◆   sShName = Format(Date, "yyyymmdd (") & Val(Split(sShName & " (", " (")(1)) + 1 & ")" ' ◆   Resume ' ◆ End Sub

komio777
質問者

お礼

こんばんわ。 細かく指導して頂き有難うございます。 全てを理解できるように頑張ってみます。 まずは検証してみます。 有難うございます。

すると、全ての回答が全文表示されます。

関連するQ&A