アプリ版:「スタンプのみでお礼する」機能のリリースについて

Excel2003です。
数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。
この非表示の状態で保存するにはどのようにすればよいのでしょうか?
【以下現在のコードです】
------------------------------------------------
Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")
If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else
With ThisWorkbook.ActiveSheet
Workbooks.Add
.Cells.Copy ActiveSheet.Range("A1")
ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
ActiveWorkbook.Close False
End With
Sheets("報告書").Select
Range("A1").Select
MsgBox "報告書を作成しました。"
End If
End Sub
----------------------------------------------------

A 回答 (4件)

Sub 名前を付けて保存()



'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")
If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else
With ThisWorkbook.ActiveSheet
Workbooks.Add
.Copy After:=ActiveWorkbook.Sheets(1)
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(1).Delete
Application.DisplayAlerts = True
ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
ActiveWorkbook.Close False
End With
Sheets("報告書").Select
Range("A1").Select
MsgBox "報告書を作成しました。"
End If
End Sub

でどうでしょう。

この回答への補足

すみません。
「お礼」の欄で書かせた内容を訂正いたします。
ちょっと私混乱しておりました。非表示の件は、修正なしでは解決していませんでした。
ご指摘のコードで解決です!!
ありがとうございました。

補足日時:2008/08/11 23:59
    • good
    • 0
この回答へのお礼

すみません。
Excel2003とは書いたのですが、実はExcel2007で作成をして保存をする時にExcel97-2003で互換性のある形で保存しております。これがいけなかったのでしょうか・・・
本日改めて本当のExcel2003のソフトで保存したところ、コードの修正をすることなく非表示の件もうまくいきました。
もちろん、ご指摘いただいたコードでもうまくいきました。
Exscel2007は最近使用し始めたばかりで、よくわかっていません。

お礼日時:2008/08/11 23:40

こんにちは。



提案1

他の不要のシートが必要ない場合。

 With ThisWorkbook.ActiveSheet
      .Copy
      ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
      ActiveWorkbook.Close False
End With
    
提案2

PasteSpecial を使う方法。

With ThisWorkbook.ActiveSheet
      Workbooks.Add
      .Cells.Copy
      ActiveSheet.Cells.PasteSpecial
      ActiveSheet.Cells(1, 1).Select
      ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
      ActiveWorkbook.Close False
End With
  Application.CutCopyMode = False '必要に応じて
    • good
    • 1
この回答へのお礼

ありがとうございます。
とても参考になりました。

お礼日時:2008/08/12 00:15

#1です。

 補足します。
そちらのコードをそのまま実行すると別のブックを新規で作成して
おり(Workbooks.Add)、そのブックのSheet1がアクティブシートと
いう状態で下記のコマンドを実行しています。

.Cells.Copy ActiveSheet.Range("A1")
ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
ActiveWorkbook.Close False

ですから空のファイルができているのではないかと思いますが・・
マクロ実行時にステップで行うと動きがわかりますよ。 F8で
次の行を順次実行していきます。
ご確認ください。
    • good
    • 0
この回答へのお礼

ありがとうございます。
現在の私のコードで非表示以外は問題なく新規のファイルで保存されます(空の状態ではありません)

お礼日時:2008/08/11 23:34

こんにちは


下記のような感じでどうですか?

Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant

既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")

If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else

'With ThisWorkbook.ActiveSheet コメントアウト
'Workbooks.Add コメントアウト
'.Cells.Copy ActiveSheet.Range("A1") コメントアウト

Sheets("報告書").Copy '追加 シートを別ブックにコピー
Range("A1").Select '追加 A1を選択

'ActiveWorkbook.SaveAs 保存ファイル名, xlNormal コメントアウト
ActiveWorkbook.SaveAs Filename:=保存ファイル名 _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False '文法を修正(マクロの記録で簡単にチェックできます。)

ActiveWorkbook.Close False
'End With コメントアウト

Sheets("報告書").Select
Range("A1").Select
MsgBox "報告書を作成しました。"

End If

End Sub

訂正箇所

 ブックを新しいファイルにコピー
 Save時の文法を修正

以上、ご参考まで
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!