シートAの保存を他のPCのデスクトップにしたい

このQ&Aのポイント
  • Excel2007で見よう見真似でマクロ作成の初心者です。本ブックのシートAを、他のPCでも、マクロが実行できるようにしたいです。
  • コードを修正するための参考として、次のコードがありますが、利用できませんでした。
  • アクティブブックを「デスクトップ」フォルダに「Sample.xls」という名前で保存する方法を知りたいです。
回答を見る
  • ベストアンサー

シートAの保存を他のPCのデスクトップにしたい

Excel2007で見よう見真似でマクロ作成の初心者です。3時間ほどの試行錯誤を繰り返しました。が、お手上げのため質問します。本ブックのシートAを、他のPCでも、マクロが実行できるようにしたいです。よろしくお願いします。 Option Explicit Sub シートAの保存を他のPCでしたい() ' 'Const cnsTITLE = "マクロなしブックの作成" 'Const cnsFILTER = "Excelワークブック (*.xls),*.xls" Dim xlAPP As Application Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 作成ブック Dim strFileName As String Dim tblSH As Variant Dim lngLines As Long Dim myDate As String Worksheets("シートA").Select myDate = Range("AE4").Value 'Date = Format(Date, "ge年m月度") Set WBK1 = ThisWorkbook ' 本ブック ' シートAをデスクトップの「計算綴り」にコピーする Worksheets("シートA").Copy Set WBK2 = ActiveWorkbook strFileName = Format(myDate, "ge年m月度") & ".xls" ChDir "C:\Users\aaaaa\Desktop\計算綴り"   ’私はaaaaaのため、私しかできないです。 Application.DisplayAlerts = False WBK2.SaveAs "基本計算書" & strFileName, FileFormat:=XlFileFormat.xlExcel8 MsgBox "この計算書を基本計算書 " & myDate & " の名前で保存しました。" Application.DisplayFormulaBar = True WBK2.Close False Application.DisplayAlerts = True Set WBK2 = Nothing MAKE_NEWBOOK_WO_MACROS_EXIT: Set WBK1 = Nothing Set xlAPP = Nothing End Sub -------------------------------------------- いろいろサイトを探していたら次のコードが参考になるようですが これを利用してコードを修正できません。よろしくご指導ください。 ''次のコードは、アクティブブックを「デスクトップ」フォルダに 「Sample.xls」という名前で保存します。 Sub Sample3() Dim Path As String, WSH As Variant Set WSH = CreateObject("Wscript.Shell") Path = WSH.SpecialFolders("Desktop") & "\計算綴り" ActiveWorkbook.SaveAs Path & "Sample1.xls" Set WSH = Nothing End Sub

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

  • ベストアンサー
  • Siegrune
  • ベストアンサー率35% (316/895)
回答No.1

## いろいろやり方が考えられるのでこれがいいかどうかは難しいところですけど ## せっかく見つけられたコードだから利用して。 >次のコードが参考になるようですが Dim Path As String, WSH As Variant Set WSH = CreateObject("Wscript.Shell") Path = WSH.SpecialFolders("Desktop") & "\計算綴り" ActiveWorkbook.SaveAs Path & "Sample1.xls" Set WSH = Nothing を ChDir "C:\Users\aaaaa\Desktop\計算綴り"   ’私はaaaaaのため、私しかできないです。 の直前に追加して ChDir Path と変更してみればどうでしょう? ## 試していませんけど。

aitaine
質問者

お礼

完璧にできました。ありがとうございました。

関連するQ&A

  • シートの複写をデスクトップのフォルダに挿入したい

    Excel2007でマクロ作成中の初心者です。 今正常に作動しているマクロコード「この計算シートの保存」をもとに 「この計算シートをデスクトップの決まったフォルダに挿入」としたいです。 どう変更したらいいかご指導お願いします。 ------------------------------------------- Sub この計算シートをデスクトップの決まったフォルダに挿入() ' 'Const cnsTITLE = "マクロなしブックの作成" 'Const cnsFILTER = "Excelワークブック (*.xls),*.xls" Dim xlAPP As Application Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 作成ブック(新規ブック) Dim strFileName As String Dim tblSH As Variant Dim lngLines As Long Dim myDate As String myDate = Range("AE4").Value 'Date = Format(Date, "ge年m月度") Set WBK1 = ThisWorkbook ' 本ブック ' この計算シートをデスクトップの「計算書庫」フォルダに挿入する   Worksheets("この計算シート").Copy Set WBK2 = ActiveWorkbook strFileName = Format(myDate, "ge年m月度") & ".xls" ChDir ThisWorkbook.Path + "\計算書庫" 'デスクトップの「計算書庫」フォルダに変更したい Application.DisplayAlerts = False WBK2.SaveAs "定期計算書" & strFileName, FileFormat:=XlFileFormat.xlExcel8 MsgBox "この計算書を " & myDate & " の名前でデスクトップの「計算書庫」フォルダに挿入しました。" Application.DisplayFormulaBar = True WBK2.Close False Application.DisplayAlerts = True Set WBK2 = Nothing MAKE_NEWBOOK_WO_MACROS_EXIT: Set WBK1 = Nothing Set xlAPP = Nothing End Sub ---------------------------------------------- Sub この計算シートの保存() ' 'Const cnsTITLE = "マクロなしブックの作成" 'Const cnsFILTER = "Excelワークブック (*.xls),*.xls" Dim xlAPP As Application Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 作成ブック(新規ブック) Dim strFileName As String Dim tblSH As Variant Dim lngLines As Long Dim myDate As String myDate = Range("AE4").Value 'Date = Format(Date, "ge年m月度") Set WBK1 = ThisWorkbook ' 本ブック ' この計算シートを新規ブックにコピーする Worksheets("この計算シート").Copy Set WBK2 = ActiveWorkbook strFileName = Format(myDate, "ge年m月度") & ".xls" ChDir ThisWorkbook.Path + "\計算書庫" Application.DisplayAlerts = False WBK2.SaveAs "計算書庫"" & strFileName, FileFormat:=XlFileFormat.xlExcel8 MsgBox "この計算書を " & myDate & " の名前で保存しました。" Application.DisplayFormulaBar = True WBK2.Close False Application.DisplayAlerts = True Set WBK2 = Nothing MAKE_NEWBOOK_WO_MACROS_EXIT: Set WBK1 = Nothing Set xlAPP = Nothing End Sub

  • シートを複写して既にあるブックの中に挿入したい

    Excel2007でマクロ作成中の初心者です。 現在下記のコードにより、自分のPC、他のPCで正常に、マクロ実行しています。 1)このマクロは、年間12個のブックができますので、加工が面倒です。そのため これを、デスクトップのフォルダ「実績綴り」内の、「年間集計表」というブックの  最前列のシートの前に追加していきたいのです。そうすれば、1年分がひとつのブックに 保存されるので何かと便利です。 3)追加するシート名が、無いときは問題ないですが、既にある場合は、複製が挿入されるので  最新のシートと古いシートが混在してしまいます。何か工夫はないでしょうか 。以上よろしくご指導をお願いします。 ’-------------------------------------------- Sub シートの保存() ' 現在使用しているマクロコード ’1)ブックには、シートの名「月売上」がある。 ’2)このシートを複写して、新規ブックを作成する。 ’3)このシートの「月売上」セル「R4の値」を、新規ブック名とする。 ’4)保存先は、デスクトップのフォルダ「実績綴り」とする。 ’5)セル「R4の値」が変更されない限り、上書きされるので、データは常に最新である。 Application.ScreenUpdating = False 'Const cnsTITLE = "マクロなしブックの作成" 'Const cnsFILTER = "Excelワークブック (*.xls),*.xls" Dim xlAPP As Application Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 作成ブック Dim strFileName As String Dim tblSH As Variant Dim lngLines As Long Dim myDate As String Worksheets("月売上").Select myDate = Range("R4").Value Set WBK1 = ThisWorkbook ' 本ブック ' 指定シートを新規ブックにコピーする Worksheets("月売上").Copy Set WBK2 = ActiveWorkbook strFileName = Format(myDate, "ge年m月度") & ".xls" Dim Path As String, WSH As Variant Set WSH = CreateObject("Wscript.Shell") Path = WSH.SpecialFolders("Desktop") & "\実績綴り" Set WSH = Nothing ChDir Path Application.DisplayAlerts = False WBK2.SaveAs "月売上" & strFileName, FileFormat:=XlFileFormat.xlExcel8 Application.DisplayFormulaBar = True WBK2.Close False Application.DisplayAlerts = True Set WBK2 = Nothing MAKE_NEWBOOK_WO_MACROS_EXIT: Set WBK1 = Nothing Set xlAPP = Nothing End Sub

  • 保存したときに毎回出る、不可思議なエラーを回避するには?

    vistaでExcel2007を使用して次のマクロを実行すると Sub MAKE_NEWBOOK_WO_MACROS004() 'Const cnsTITLE = "マクロなしブックの作成" 'Const cnsFILTER = "Excelワークブック (*.xls),*.xls" Dim xlAPP As Application Dim WBK1 As Workbook ' 本ブック Dim WBK2 As Workbook ' 作成ブック Dim strFILENAME As String Dim tblSH As Variant Dim lngLines As Long Set WBK1 = ThisWorkbook ' 本ブック ' 指定シートを新規ブックにコピーする Worksheets("印刷").Copy Set WBK2 = ActiveWorkbook strFILENAME = Format(Date, "ggge年m月d日") & ".xls" Application.DisplayAlerts = False フォームコントロール削除 WBK2.SaveAs "請求書" & strFILENAME MsgBox "この請求書 を保存しました。" Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Application.DisplayFormulaBar = False WBK2.Close False Application.DisplayAlerts = True Set WBK2 = Nothing MAKE_NEWBOOK_WO_MACROS_EXIT: Set WBK1 = Nothing Set xlAPP = Nothing End Sub 次のような表示が毎回出ます。 [開こうしているファイルAAAの形式は、ファイル拡張子が示す形式と異なります。このファイルを開く前に、ファイルが破損していないこと、信頼できる発行元からのファイルであることを確認してください。ファイルを今すぐひらきますか?] OKすると、正常にファイルが表示されます。 このエラーを表示させないようにしたいのです。よろしくお願いします。

  • シートを他のブックに貼付けたい

    Excel2007でマクロ作成中の初心者です。 やりたいことは 1)本ブックの中の「当月売上」シートを他ブックに貼付けたいです。 2)他ブックに貼り付けた「当月売上」シート名は、セルK1の日付に変更したいです。 すると、他ブックのシートが毎月順に、売上(2012年4月) 売上(2012年5月) 売上(2012年6月)というふうに増えます。 3)何月に作成しても、ブックの「当月売上」シートを貼り付けます。 四苦八苦して以下のコードをつくりましたが、「同じ名前のシート名に変更できません。」 というエラーがでるので、このエラーが出ないように、名前が同じ時は上書き保存し、違うときは新しいシート名を作るという コードにしたいです。困ってます。どうかご指導お願いします。 Sub 売上シートの貼付け() Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 貼付け先他ブック ChDir ThisWorkbook.Path + "\売上" On Error Resume Next Set WBK2 = Workbooks("24年度売上.xls") On Error GoTo 0 If WBK2 Is Nothing Then Set WBK2 = Workbooks.Open(ThisWorkbook.Path & "\売上\24年度売上.xlsm") End If Worksheets("当月売上").Copy After:=Workbooks("24年度売上.xlsm").Sheets(Workbooks("24年度売上.xlsm").Sheets.Count) ActiveSheet.Name = Format(Range("K1").Value, "売上(yyyy年mm月)") Application.DisplayFormulaBar = True WBK2.Close SaveChanges:=True Application.DisplayAlerts = True Set WBK2 = Nothing End Sub

  • VBで既存エクセルシートを新規ブックにコピー

    VB6,Excel2003です。 既存のエクセルシートを新規ブックにコピーする プログラムを作成してみましたが タスクバーに新規ブックのタスクバーボタンが2つできてしまいます。 どこが原因か教えてください。よろしくお願いします。 Private Sub Command1_Click() Dim xlsApp As Excel.Application Dim xlsBookTemp As Excel.Workbook 'コピー元ブック Dim xlsBookCopy As Excel.Workbook 'コピー先ブック Dim xlsSheetTemp As Excel.Worksheet 'コピー元シート Dim xlsSheetCopy As Excel.Worksheet 'コピー先シート Set xlsApp = CreateObject("Excel.Application") Set xlsBookTemp = xlsApp.Workbooks.Open("C:\Temp.xls") Set xlsSheetTemp = xlsBookTemp.Sheets(1) Set xlsBookCopy = xlsApp.Workbooks.Add Set xlsSheetCopy = xlsBookCopy.Sheets(1) xlsApp.Visible = True 'コピー元のSheet1を新規ブックにコピーする xlsSheetTemp.Copy Before:=xlsSheetCopy 'コピー元のブックは閉じる xlsBookTemp.Close '///新規ブックの編集処理/// Set xlsSheetTemp = Nothing Set xlsBookTemp = Nothing Set xlsSheetCopy = Nothing Set xlsBookCopy = Nothing Set xlsApp = Nothing End Sub

  • 他のブックからシートをコピーする

    ExcelVBA勉強中の者です。 他のブックのsheet1をコピーし、使用中のブックのsheet1にペーストする事を目的に ネットの情報を参考に以下のコードを作成しました。 Sub test() Dim book1 As Workbook '変数book1をワークブック型で宣言 Dim book2 As Workbook '変数book2をワークブック型で宣言 Set book1 = Application.ActiveWorkbook 'アクティブになっているブックをbook1へセット Application.ScreenUpdating = False '画面の更新を止める '↓アドレスのブックを開く事までbook2にセット(ReadOnly:=Trueで読み込み専用) Set book2 = Application.Workbooks.Open("C:\Documents and Settings\AAA\デスクトップ\他のブック.xls", ReadOnly:=True) book2.Sheets("Sheet1").Copy after:=book1.Worksheets("sheet1") Set book1 = Nothing '変数book1を開放 book2.Close SaveChanges:=False 'book2を閉じる(SaveChanges:=Falseで保存せずに終了) Application.ScreenUpdating = True '画面の更新を再開する Set book2 = Nothing '変数book2を開放 End Sub 動作としては上手くいったのですが、 book2.Sheets("Sheet1").Copy after:=book1.Worksheets("sheet1") の部分でペースト先を変数book1のsheet1と指定しているにも関わらず sheet1(2)という新しいシートが作成され、そちらへペーストしてしまいます。 思うに「コピーしたシートを挿入する」という動作であると思われますが、 これをペーストするという表記が出来ず困っております。 お手数お掛けしますがどなたかご助力お願い致します。 *Excelのバージョンは2002を使用しております。

  • ACCESSでExcelにデータ出力、高速化

    ACCESSのVBAを使ってテーブルのデータを 既存ブックに出力し、別名で保存をしたいのですが、 どうも、処理が遅くて困っています。 改善点がありましたら教えてくださいお願いいたします。 Dim objExcel As Excel.Application Dim xlWrkbk As Excel.Workbook Dim xlWrksh As Excel.Worksheet Dim rs As DAO.Recordset Dim strFilename As String strFilename = CurrentProject.Path & "既存ブック名.XLS" Set objExcel = New Excel.Application Set xlWrkbk = objExcel.Workbooks.Open(Filename:=strFilename, ReadOnly:=True) Set xlWrksh = xlWrkbk.Worksheets("シート名") Set rs = CurrentDb.OpenRecordset("テーブル名", dbOpenSnapshot) With objExcel xlWrksh.Range("A:N").Clear xlWrksh.Range("A2").CopyFromRecordset rs xlWrkbk.SaveAs Filename:=CurrentProject.Path & "新しいブック名.xls" xlWrkbk.Close .Quit rs.Close End With Set rs = Nothing Set objExcel = Nothing Set xlWrkbk = Nothing Set xlWrksh = Nothing

  • 年月を付けて、ブックを保存したい

    Excel2007でマクロ作成中の初心者です。 毎月、「24年月次報告 年 月.xls 」というブックを作成しています。 以下のコードで、作成しています。 このコードを実行すると、デスクトップの「常勤」というフォルダの中の「一覧表」というフォルダに 「24年月次報告 年 月.xls」 というブックができます。 このコードを修正して、5月中に作成したら、「24年月次報告24年5月.xls」 というブック、 6月中に作成したら、「24年月次報告24年6月.xls」 というブックを作成したいのです。 どのように修正したら、それが実行できるのでしょうか。ご指導お願いします。 Sub 給与計算24年データの保存() Dim Path As String, WSH As Variant Set WSH = CreateObject("WScript.Shell") Path = WSH.SpecialFolders("Desktop") & "\常用\一覧表\24年月次報告" ActiveWorkbook.SaveAs Path & " 年 月.xls" Set WSH = Nothing End Sub

  • シートのコピーでプロセスが残ってしまう

    シートのコピーでプロセスが残ってしまう vb2008よりエクセルを起動し、シートを同一のブック内でコピーしようと思うのですが、 下記コードだとシートのコピーはできるのですがリソースが解放できず、プロセスが残ってしまいます。 wsh.Copy(wshh) の部分を wsh.Copy()にして違うブックにコピーすると問題無い。 Excel2003以降の複数のバージョンに対応させるため、CreateObjectを使用しています。 この場合、wsh.copy の部分はどのように記述すれば良いのでしょうか? わかりやすくするため例外等のコードは省いています。 Dim app As Object Dim wbs As Object Dim wb As Object Dim wshs As Object Dim wsh As Object Dim wshh As Object app = CreateObject("Excel.Application") wbs = app.Workbooks wb = wbs.Open("c:\hoge.xls") wshs = wb.Worksheets wsh = wshs.item(1) wshh = wshs.item(1) wsh.Copy(wshh) wb.Close() wbs.close() app.Quit() System.Runtime.InteropServices.Marshal.ReleaseComObject(wshh) System.Runtime.InteropServices.Marshal.ReleaseComObject(wsh) System.Runtime.InteropServices.Marshal.ReleaseComObject(wshs) System.Runtime.InteropServices.Marshal.ReleaseComObject(wb) System.Runtime.InteropServices.Marshal.ReleaseComObject(wbs) System.Runtime.InteropServices.Marshal.ReleaseComObject(app) wshh = Nothing wsh = Nothing wshs = Nothing wb = Nothing wbs = Nothing app = Nothing

  • VBA

    VBAでstrFILENAMEにaaa.xlsを代入したいのですがどうしたらいいのでしょうか? このままだと定義エラーになっていまします。 Dim wbk As Workbook Set wbk = Workbooks.Open(Filename:="C:\Documents and Settings\Administrator\デスクトップ\strFILENAME", ReadOnly:=True)

専門家に質問してみよう