人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルのVBAでお願いします。バージョンは2002です。
アクティブシートを別ブックにして(セル内はテキストに変換して)サーバー上の任意のフォルダに別のファイル名で保存するVBAを希望します。

詳しく説明します。添付画像の通り、4月シートのA1からH33のセル(ここでは何も表示されていませんが実際は関数が入っています)のすべてをテキストデータに直してから、この選択部分のみのファイルにします。シート名は”4項目1(4月)”にして(これはF1からH1のセル内テキストと本来のシート名を組み合わせた文字です)、同じ名前のファイル名(4項目1(4月).xls)にしてから、サーバー上のフォルダ(\\Server\4月)に保存します。

当然、5月シートがアクティブになっているときは、A1からH33のセルをテキストにしてファイル名とシート名を”4項目1(5月)”にして、”\\Server\5月”に保存したいというわけです。もちろん3月まで行います。

説明が不十分かもしれませんが、よろしくお願いします。

1206170553
●拡大する

●質問者: anglar
●カテゴリ:はてなの使い方 コンピュータ
✍キーワード:F1 h1 xls アクティブ エクセル
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● Mook
●100ポイント ベストアンサー

一応ご希望の仕様で作成した例です。


気になるのはサーバの下に、シート名と同名(#月)のフォルダがあることを前提にしていますが、

これは問題ないでしょうか。

下記のコードでは一度フォルダのパスをチェックし、なければフォルダを作成する処理を入れています。


質問に書かれているように、アクティブなシートを処理する場合は ActiveSheetSave

ブック内のすべてのシートを処理する場合は AllSheetsSave をお使いください。


不明な点はコメントにて対応しますので有効にお願いします。

Option Explicit

'-----------------------------------------
' 保存先のフォルダ
'-----------------------------------------
Const SERVER_PATH = "\\server\"

'-----------------------------------------
' すべてのシートを個別に保存
'-----------------------------------------
Sub AllSheetsSave()
 Dim srcWS As Worksheet
 
 For Each srcWS In ThisWorkbook.Worksheets
 saveMonthlyBook srcWS
 Next
End Sub

'-----------------------------------------
' アクティブなシートを保存
'-----------------------------------------
Sub ActiveSheetSave()
 saveMonthlyBook ActiveSheet
End Sub

'-----------------------------------------
Sub saveMonthlyBook(srcWS As Worksheet)
 srcWS.Copy
 
 Dim dstWB As Workbook
 Set dstWB = ActiveWorkbook
 
  '--- データを値としてコピー
 srcWS.Range("A1:H33").Copy
 dstWB.Worksheets(1).Range("A1:H33").PasteSpecial _
 Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
 Dim folderPath$, fileName$
 
 With srcWS
 folderPath = SERVER_PATH & .Name
 fileName = .Cells(1, "F") & .Cells(1, "G") & .Cells(1, "H") & "(" & .Name & ").xls"
 
  '--- シート名と同名のフォルダがなければ作成
 If Dir(folderPath, vbDirectory) = "" Then
 MkDir folderPath
 End If
 End With
 dstWB.SaveAs folderPath & "\" & fileName
 
 dstWB.Close
End Sub
◎質問者からの返答

いやあ、すごいッス。こんなに早く感心しきりです。今、サーバー環境にいないので、とりあえずローカルフォルダで試しましたが、満足できます。感謝です。 '--- シート名と同名のフォルダがなければ作成 まで作っていただき、さらに感謝です。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ