EXCELマクロ実行後、読み込み専用になってしまう
- EXCELマクロ実行後に読み取り専用になる問題が発生しています。PCを再起動すると解除されますが、読み取り専用にならない方法はありますか？
- マクロを実行して別のファイルのシートを取り込んだ後、そのファイルが読み取り専用になってしまいます。ご指導いただけると助かります。
- Excelのマクロを実行すると、取り込んだファイルが読み取り専用になってしまいます。再起動すると解除されますが、解決策はありますか？
- ベストアンサー
EXCELマクロ実行後、読み込み専用になってしまう
EXCELマクロ実行後に読み取り専用になってしまう。 ＜内容＞ １つのファイル（Ａ）に他の複数のファイル（Ｂ，Ｃ・・・）内のシートを取り込んだ後、更新せずに終了させています。 ＜困ったこと＞ そのマクロを実行したあと上記のファイルＢ，Ｃ・・・が読み取り専用になってしまいます。ＰＣを再起動すると解除されます。 読み取り専用にならないようにする方法はありますでしょうか。 ご指導のほど、よろしくお願いいたします。 ＜参考＞ For Each fName In FSO.GetFolder(MyFolder).Files If FSO.GetExtensionName(fName) = "xls" And _ FSO.GetBaseName(fName) <> "ファイルＡ" Then Set wBook = Workbooks.Open(fName) For 番号 = 1 To Worksheets.Count wBook.Worksheets(番号).Copy _ after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Next 番号 wBook.Close True End If Next
- pin3891227
- お礼率85% (35/41)
- その他(ソフトウェア)
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
試してないのでどうして読取り専用になるのかはわかりませんが、 Set wBook = Workbooks.Open(fName) を Set wBook = Workbooks.Open(fName,0,True) にして、最初から読み取り専用で開いてコピーしてみたらどうでしょう？
関連するQ&A
- ファイル名を変数として取り扱いたい
ファイル名が変更されても正常に動作するようにしたい ＜処理概要＞ A.XLS、B.XLS、C.XLSというファイルがあります。 A.XLSにB.XLS、C.XLSのシートを取り込む処理をしています。 マクロはA.XLSで起動、処理しています。 A.XLSのファイル名を変更されても動くようにできるのでしょうか。 ご指導のほど、よろしくお願いいたします。 ＜ファイルの取り込み処理＞ For Each fName In FSO.GetFolder(MyFolder).Files If FSO.GetExtensionName(fName) = \\\"xls\\\" And _ FSO.GetBaseName(fName) <> \"A\" Then Set wBook = Workbooks.Open(fName, 0, True) For 番号 = 1 To Worksheets.Count wBook.Worksheets(番号).Copy _ after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Next 番号 wBook.Close False End If
- ベストアンサー
- オフィス系ソフト
- VBA フォルダ内ファイルにマクロ一括処理
フォルダ内ファイルのマクロを一括実行したいです。 フォルダ内ファイル全てに下記のマクロを登録 Sub 値貼り付け() 'シート4番目を選択 Sheets(4).Select 'シート名1文字目が「★」以外のシートを選択 For Each i In ThisWorkbook.Sheets If Not i.Name Like "★*" Then i.Select Replace:=False End If Next i '全セル選択 Cells.Select 'コピー Selection.Copy '値貼り付け Selection.PasteSpecial Paste:=xlPasteValues Cells(1, 1).Select Sheets(1).Select '「.xlsx」で保存 Application.DisplayAlerts = False Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") With ActiveWorkbook f = fso.GetBaseName(.Name) .SaveAs .Path & "\" & f & "保存.xlsx", FileFormat:=xlWorkbookDefault .Close End With Set fso = Nothing End Sub 一括でマクロを実行する用のファイルに下記マクロを登録 Sub 一括処理() Dim Fpath As String Dim Fname As String Dim Wb As Workbook Fpath = ThisWorkbook.Path & "\" Fname = Dir(Fpath & "*.xlsm") Do Until Fname = "" If Fname = ThisWorkbook.Name Then Else Application.DisplayAlerts = False 'ブックを開く Set Wb = Workbooks.Open(Fpath & Fname) 'マクロ実行 Application.Run "'" & Fname & "'!値貼り付け" Wb.Close SaveChanges:=True Application.DisplayAlerts = True End If Fname = Dir() Loop End Sub 一括処理の実行をすると、フォルダ内の一つのファイルだけ マクロ実行されると終了してしまいます。 各々のファイルには他にもマクロを登録していて、そちらは 'マクロ実行 Application.Run "'" & Fname & "'!値貼り付け" のマクロの名前部分を変更して、同様に一括処理していますが 問題なく動きます。 なぜかこの「値貼り付け」のマクロだけ全ファイルに動作して くれません。 色々自分なりに調べているのですが、どうしても原因不明で 今回投稿させて頂きました
- ベストアンサー
- Excel（エクセル）
- エクセルのマクロについて
エクセルで写真帳を作成してるのですが、 保存容量が大きいため、下記のマクロをコピペしたのですが 画像は消えてしまい困ってます。 (1)どなたか下記のマクロ解読お願いします。 (2)それと、新しく保存すると、jpegの画像が消えてしまい どうしたらよいかわからない。 (3)ボタンを作成してまして、これも消したい。 オブジェクト削除なのかなぁ？ わがまま言ってすいません。自分には無理なんでお願いします。 Option Explicit Sub Macro1() Dim SheetCount As Integer Dim i As Integer Dim fname As String Dim Ws As Worksheet Dim OrgWorkBook As Workbook Dim NewWorkBook As Workbook SheetCount = Worksheets.Count ChDir "C:\Documents and Settings\たかじん\デスクトップ" fname = Application.GetSaveAsFilename _ (, "Microsoft Excel ブック (*.xls), *.xls") If fname = "False" Then Exit Sub Set OrgWorkBook = ActiveWorkbook Workbooks.Add (xlWBATWorksheet) Set NewWorkBook = ActiveWorkbook For i = 2 To SheetCount Sheets.Add after:=Worksheets(Worksheets.Count) Next OrgWorkBook.Activate i = 1 For Each Ws In Worksheets Ws.Cells.Copy Destination:=NewWorkBook.Sheets(i).Range("A1") i = i + 1 Next NewWorkBook.Activate ActiveWorkbook.Close True, fname ChDir Application.DefaultFilePath
- 締切済み
- Visual Basic
- ■助けてください。■エクセルのマクロで困っています。
エクセルで、シートを一つ削除するマクロを教えてください。 本当に困っています。 マクロをご存知の方、ずぶの素人の私にご教示何卒よろしくお願いします。 文末にマクロを記述いたしますが、そちらは、 指定した日付以降にエクセルのファイルを開くと シートがすべて削除されて、「有効期限切れ」という シートだけが出てくるというものです。 現在、これを応用して、すべてのシートを 削除するのではなく、ひとつのシートだけ削除したいのです。 例えば「SheetA」、「SheetB」、「SheetC」、「有効期限切れ」という ４つのシートがあったとして、 指定した期日が来たら、「SheetC」だけを削除したいのです。 なお、エクセルファイルを開く際に、マクロを無効にされてしまうと 期日が来てもSheetCが削除されずに 残ってしまっては困るのです。 そこで、マクロを有効にしないと SheetCが現れないようにしたいのです。 （以下のマクロではそのようになっています） 一つだけシートを削除するマクロをやり方をご存知の方、マクロのご教示のほど 何卒よろしくお願い致します。 なお、小生、マクロはずぶの素人でして、 マクロの文面を頂いてコピー貼り付けするぐらいしか 能がありません。 つきましては、以下の文面を モディファイしてご教示頂けませんでしょうか。 よろしくお願いいたします。 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) endsheetname = "有効期限切れ" If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Sheets("SheetA ").Visible Then Sheets("SheetC ").Visible = xlVeryHidden End Sub Private Sub Workbook_Open() endsheetname = "有効期限切れ" If Date >= "3008/09/29" Then Application.DisplayAlerts = False If Sheets.Count = 1 Then If Sheets(1).Name <> endsheetname Then Sheets.Add(After:=ActiveSheet).Name = endsheetname End If Else On Error Resume Next Sheets(endsheetname).Delete On Error GoTo 0 Sheets.Add(After:=ActiveSheet).Name = endsheetname End If sheetnumber = Sheets.Count For i = 1 To sheetnumber For j = 1 To 2 If Sheets.Count = 1 Then Exit For If Sheets(j).Name = " SheetC " Then If Not Sheets("SheetC ").Visible Then Sheets("SheetC ").Visible = True If Sheets(j).Name <> endsheetname Then Sheets(Sheets(j).Name).Delete: Exit For Next Next Range("b" & 3).Value = "ご利用ありがとうございました。" ActiveWorkbook.Save Application.DisplayAlerts = True End If If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Not Sheets(" SheetC ").Visible Then Sheets(" SheetC ").Visible = True End Sub
- 締切済み
- オフィス系ソフト
- マクロ実行後エクセルを閉じたい
２つの別々のファイルを開いて片方からもう片方にコピーして 保存して終了する。（両方とも閉じる） というマクロを作ったのですが コピー終了後に実行したマクロ付きのエクセルも閉じてデスクトップ上には何も開いていない状態にしたいのですがworkbookのところに 下記の命令を記述してもうまくいきません。 Application.Run "ＸＸＸＸＸＸ" ThisWorkbook.Save ThisWorkbook.Saved = True If Workbooks.Count <= 1 Then Application.Quit ThisWorkbook.Close False マクロ付きのエクセルも一旦は閉じるのですがその後に 別の白紙のブックが開いてしまうのです。 続けて他のマクロをスケジュールで実行したいのですが実行時に 「既にエクセルが開いています」みたいな警告が表示され 実行できません。 エクセルを完全に閉じるようにするにはどうしたらいいのでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ
以下のマクロを作成し Fnameを開き、そのファイルで特定の文字列を探し、Offsetしたセルの値のコピー＆ペーストをしようとしています。 しかし、ファイルは開くのですが、コピー＆ペーストをいません。 どのようにすれば、実行できるのでしょうか？ 変数やOffsetの使い方が違うと思うのですが、教えてください。 Dim Wbk As Workbook Dim Fname As String Dim f As Integer For f = 1 To 100 ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path Fname = Cells(f, 1).Value & ".xls" Application.ScreenUpdating = False Workbooks.Open (Fname), UpdateLinks:=0 Set Obj = Worksheets(Cells(f, 2).Value).Cells.Find(Cells(f, 3).Value) Obj.Offset(24, 0).Copy Obj.Offset(36, 0).PasteSpecial (xlPasteValues) Application.CutCopyMode = False Application.DisplayAlerts = False Workbooks(Fname).Close SaveChanges:=True Application.DisplayAlerts = True Application.ScreenUpdating = True Next f
- ベストアンサー
- オフィス系ソフト
- マクロ実行が遅い・・・
皆さんにおしえてもらいながら下記のようなマクロを組みました。 しかし、マクロを実行すると計算中が長いのです。 もしこのマクロに原因があれば教えてください。 よろしくお願いします。 －－－－－－－－－－－－－－－－－－－－－－－－－－ Sub 見積書作成() Sheets("見積書").Select '見積書シートを選択 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" Then '工数が「0」のときは Rows(i).RowHeight = 0 '行高さ「0」 End If Next For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next Dim Rng As Range Const Retu = "C" '<--- ここで「小計」の列を指定します。 For Each Rng In Range(Retu & "1", Range(Retu & "65536").End(xlUp)) If Trim(Rng.Value) = "小 計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルマクロでシートの切り替え場うまくいかない。
エクセルマクロでシートの切り替え場うまくいかない。 以下のマクロで「Acount」から抜けて「Bcount」に移った時BcamのBsheetではなくAsheetをそのまま読み込んでしまいます。 なぜだかわかりますか。 For Bcount = 3 To 52 Bcam = Worksheets(Bsheet).Cells(Bcount, retu + 1) For Acount = 4 To 92 Acam = Worksheets(Asheet).Cells(Acount, retu + 1) Rp = Worksheets(Asheet).Cells(Acount, retu + 8) If Acam = Bcam Then Sheets(Bsheet).Cells(gyou + 2, Xscal + 1) = Application.RoundDown(Rp, -3) Sheets(Bsheet).Cells(gyou + 2, Xscal + 2) = Acam Sheets(Bsheet).Cells(gyou + 2, Xscal + 3) = Bcam Sheets(Bsheet).Cells(gyou + 2, Xscal + 4) = Acount Sheets(Bsheet).Cells(gyou + 2, Xscal + 5) = Bcount gyou = gyou + 1 Acam = Worksheets(Asheet).Cells(gyou + 3, retu + 1) Rp = Worksheets(Asheet).Cells(gyou + 3, retu + 8) End If Next Next
- ベストアンサー
- その他（プログラミング・開発）
- マクロボタンのシートをコピーしたいのですが。。。
こんにちは。 たくさんあるファイルを一つのファイルにシート別にまとめるマクロを作成しました。 毎月同じことをするので、マクロボタンを作成したところ、作成したつきのボタンは正常に作動しますが、このシートを新しいBOOKにコピーして翌月分を作成したところ、マクロが消えてしまい、実行されません。 毎月のことなので、いちいち『前月のマクロをコピーして実行』などしないで、このボタンをコピーすればあとは押すだけ♪なんていう風にうまくいかないものでしょうか？ かなり初心者な者で、上手な説明が出来ず申し訳ございません。 Sub 精算用5月() Dim fs As Variant Dim s As Variant Dim w As Workbook fs = Application.GetOpenFilename(Title:="select xls(s)", MultiSelect:=True) If Not IsArray(fs) Then Exit Sub For Each s In fs Set w = Workbooks.Open(Filename:=s) w.Worksheets(1).Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = Application.Substitute(w.Name, ".xls", "") w.Close savechanges:=False Next Worksheets(1).Range("A1").Formula = "=SUM(" & Worksheets(2).Name & ":" & Worksheets(Worksheets.Count).Name & "!A1)" End Sub 上記のマクロでボタンを作成しました。 よろしくお願いいたします。
- ベストアンサー
- 財務・会計・経理
- エクセルのシートをマクロで並び替えたいです。
以前に、Q&Aがあったので、下記の物を入れてみましたが、シート名に会社名を入れている為、前(株)○○となると、全て(株)で集まってしまいます。 エクセル2003を使っています。 Sub SortSheets() Dim intLoopA As Integer Dim intLoopB As Integer For intLoopA = 1 To Sheets.Count For intLoopB = 1 To Sheets.Count - 1 If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then Sheets(intLoopB).Move after:=Sheets(intLoopB + 1) End If Next intLoopB Next intLoopA End Sub ご理解いただけますでしょうか？ お分かりになられる方宜しくお願い致します。
- 締切済み
- オフィス系ソフト
お礼
実際に盛り込んで動かしてみていますが、今のところ再現はしていません。発想の転換ですよね・・・。ありがとうございました。