こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excelで任意のセルのデータをファイル名に追加して上書き保存するマクロ

Excelのブックが300個ほどあります。
現在アルファベット4文字のファイル名がついています。
このブックを1つずつ開き、任意のセル(ブックごとに異なる)を選択後ホットキーでマクロを起動し選択したセルの内容をもともとのファイル名に追加して名前を付けて保存したいのです。

例)
元のファイル名:bgf.xls
選んだセル:A4
A4の内容:あいうえお
新しく保存するファイル名:あいうえおbgf.xls

環境はwin2k、Excel2kです
よろしくお願いします。

投稿日時 - 2006-01-19 14:06:01

QNo.1906697

すぐに回答ほしいです

質問者が選んだベストアンサー

こんにちは。

ホットキーで?

あまり、きちんとしたチェックをしたわけではありませんが、対話型で作るなら、以下のようになりますね。

Sub RenameFiles()
  Dim FileName As Variant
  Dim BaseFName As String
  Dim myPathName As String
  Dim NewFileName As String
  Dim fn As Variant
  Dim rng As Variant
 
  FileName = Application.GetOpenFilename("Excel(*.xls),*.xls", MultiSelect:=True)
  If VarType(FileName) = vbBoolean Then Exit Sub
  For Each fn In FileName
   On Error Resume Next
   Set rng = Application.InputBox(fn & vbCrLf & _
   "の名前の変更をします。" & vbCrLf & "セルを選択してください。", "ファイル名変更", "$A$4", Type:=8)
   On Error GoTo 0
   If VarType(rng) = vbEmpty Or rng Is Nothing Then Exit Sub
   
   If IsEmpty(rng.Value) Then
     MsgBox "セルが空です。", vbCritical
     Else
     BaseFName = Mid$(fn, InStrRev(fn, "\") + 1)
     myPathName = Mid$(fn, 1, InStrRev(fn, "\"))
     NewFileName = myPathName & rng.Value & BaseFName
     If Dir(NewFileName) = "" Then
      On Error GoTo ErrHandler
      If MsgBox(NewFileName & vbCrLf & " に変更してよろしいですか?", vbOKCancel) = vbOK Then
        Name fn As NewFileName
        MsgBox "変更しました。", vbInformation
      End If
      Else
      MsgBox "同名ファイルがあります。", vbCritical
     End If
   End If
   Set rng = Nothing
   Next fn
   Exit Sub
ErrHandler:
   MsgBox Err.Number & ":" & Err.Description
   Resume Next
End Sub

投稿日時 - 2006-01-19 16:07:48

お礼

ありがとうございます。
御礼が遅くなりすみません。
教えていただいたマクロを少し加工して期待した動作するようになりました。

投稿日時 - 2006-01-25 09:30:37

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

SendKeys Sheets("Sheet1").Range("A4").Value
Application.Dialogs(xlDialogSaveAs).Show

投稿日時 - 2006-01-19 15:31:19

お礼

ありがとうございます。
ちょっと期待していたものとはちがいましたが今後の参考にさせていただきます。

投稿日時 - 2006-01-25 09:32:06

あなたにオススメの質問