エクセルマクロでファイルを作れません
- ワークブックを開く時に自動的にxmlファイルを作るマクロを組みました。
- 他のPCで試したらxmlファイルが作成されずにエラーになりました。
- マクロによるファイルの読み書きの動作が弾かれていたりするのでしょうか。
- ベストアンサー
エクセルマクロでファイルを作れません
ワークブックを開く時に自動的にxmlファイルを作るマクロを組みました。 しかし、そのマクロを組んだPCでは正常にxmlファイルが作成されますが、 他のPCで試したらxmlファイルが作成されずにエラーになりました。 その【xmlファイルが作成されなかった】理由がわかりません。 例えば、PCのセキュリティで、マクロによるファイルの読み書きの動作が弾かれていたりするのでしょうか。 以下、そのマクロの本文です。 解決の手がかりだけでも掴めましたら教えていただくと嬉しいです。 Private Sub Workbook_Open() ' ワークブックを開く時のイベント 'Cドライブ直下に「あああ.xml」ファイルが存在すれば削除 If Dir("C:\あああ.xml") <> "" Then Kill "C:\あああ.xml" Else End If 'xmlファイルを作成 ' XMLファイル保存先の指定 Dim iFileNum As Integer iFileNum = FreeFile Dim SaveFileName As String SaveFileName = "C:\あああ.xml" Open SaveFileName For Output As #iFileNum '←ここでエラーになります！！ ''xmlファイル本文の作成 Print #iFileNum, "<?xml version=""1.0"" encoding=""UTF-8""?>" Print #iFileNum, "<markers>" Print #iFileNum, "</markers>" '後処理 If iFileNum > 0 Then Close #iFileNum End Sub
- zarbon14
- お礼率100% (4/4)
- Visual Basic
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
ファイルの場所が "C:\あああ.xml" とありますが、ドライブ直下のフォルダ(C:\)は、通常、アクセス権限が限定されているため書き込みがブロックされます。 これが書き込みが失敗した原因であると推察します。 たとえば、Windows Vista のメモ帳で C:\test.txt と名前を付けて保存をしたとすると、通常、以下のようなメッセージが表示されます。 [Window Title] 名前を付けて保存 [Content] C:\test.txt この場所に保存するアクセス許可がありません。 管理者に連絡してアクセス許可を取得してください。 代わりに [ドキュメント] フォルダに保存しますか? [はい(Y)] [いいえ(N)] 回避方法は、 ・フォルダのアクセス権限を編集し書き込みを許可する フォルダのプロパティからセキュリティタブで設定します。 ※無制限のアクセスとなるためセキュリティ上、推奨しません。 ・プログラムを管理者権限で実行する プログラム（EXCEL）のショートカットを作成し、プロパティ、互換性タブの特権レベル「管理者としてこのプログラムを実行する」にチェックを入れます。 ※フリーアクセスが対象プログラムに限定されるためセキュリティ上、推奨します。 ・保存先のフォルダを変更する ユーザのアクセス権限のあるフォルダに保存するように変更します "C:\あああ.xml" を C:\Users\<User>\あああ.xml ※低い権限のままプログラムが実行できるため、セキュリティ上、最も推奨します。
その他の回答 (1)
- layy
- ベストアンサー率23% (292/1222)
想定です。参考意見です。 削除するのでなくてファイルはそのままで中身だけ空っぽ。 上書きだからあっても問題ないかも・・・。 ＞'Cドライブ直下に「あああ.xml」ファイルが存在すれば削除 削除される前の権限はどうなっているのでしょうか？。 その権限のままであれば、できたりしますか？。 新たにファイルを作成することで、 その作成者の権限がファイル作成権限に影響するのかも、というのが気がかりです。
お礼
ご回答ありがとうございます。 確かに、「あああ.xml」ファイルが既に存在してるテストケースは実施していなかったため、試して権限について確認してみたいと思います。
関連するQ&A
- EXCELで作ったマクロを別のファイルのEXCELでも使えるようにしたいです。
(1)EXCELファイルでマクロを作成しました。 (実際はここである人の知恵をお借りして作ったものですが…) しかし、(2)EXCELファイルで(1)EXCEL作成マクロが実行できません。 どのような処理をすれば、どのPCでも、どのファイルでも実行できるようなマクロに出来るのでしょうか？？ 以下にそのマクロを示します。 ↓↓↓ Sub 文字置換() '半角カタカナを全角に、全角英数を半角にするマクロ (Excel編） Dim rng As Range Dim Re As Object Dim myPat As String Dim c As Range Dim Matches As Object Dim Match As Object Dim Str1 As String Dim Str2 As String Dim buf As String Dim t As Long On Error Resume Next Set rng = ActiveSheet.UsedRange.SpecialCells _ (xlCellTypeConstants, xlTextValues) On Error GoTo 0 If rng Is Nothing Then MsgBox "変換する対象が見当たりません。", 48 Exit Sub End If '全角側 --- 半角側 (！-／ を加えれば記号も半角) myPat = "([\uFF66-\uFF9F]*)([！-｝]*)" '正規表現のパターン Set Re = CreateObject("VBScript.RegExp") Application.ScreenUpdating = False With Re .Global = True .IgnoreCase = True .Pattern = myPat For Each c In rng.Cells Set Matches = .Execute(c.Value) If Matches.Count > 0 Then buf = c.Value For Each Match In Matches If Len(Match.Value) > 0 Then Str1 = StrConv(Match.SubMatches(0), vbWide) If Str1 <> "" Then '0 =vbBinaryCompare buf = Replace(buf, Match.SubMatches(0), Str1, , , 0) End If Str2 = StrConv(Match.SubMatches(1), vbNarrow) If Str2 <> "" Then buf = Replace(buf, Match.SubMatches(1), Str2, , , 0) End If End If Str1 = "": Str2 = "" Next Match If buf <> c.Value Then c.Value = buf t = t + 1 End If End If Next c End With Set Re = Nothing Application.ScreenUpdating = True If t > 0 Then MsgBox t & "個のセルを変換しました。", 64 End If End Sub 出来れば、置換した文字数をメッセージBOXに表示したいです。
- 締切済み
- オフィス系ソフト
- エクセルのマクロを利用して
マクロ初心者でです。 いろんなサイトから引用させて頂き次のようなマクロを作成しました。 実行すると、日付と担当者氏名(A1)がファイル名となるものです。 そこで教えて頂きたいのですが、実行すると保存先がマイドキュメントに なるのですが、これを例えば「C:\日報」というフォルダが指定されるようにしたいのですが、 自分なりに、いろいろ試したのですが全くできません。 宜しくお願い致します。 Sub 名前をつけて保存() Dim SaveFileName As String, re As Variant With Sheets("sheet1").Range("A1") If .Value = "" Then MsgBox "名前が入力されていません", vbExclamation Exit Sub Else SaveFileName = Format(Now, "yyyymmdd") & "_" & .Value End If End With re = Application.GetSaveAsFilename(SaveFileName) If re = False Then MsgBox "保存を中止しました", vbExclamation Else MsgBox "日報をを保存しました", vbInformation End If End Sub
- ベストアンサー
- その他MS Office製品
- Excelのマクロについて
文字列から数値だけを抽出するマクロを見つけたのですが、抽出するデータを選択してから実行しなければなりませんでした。 抽出するデータはAセル以下にしかないので、データを選択しないでも実行できるようにするにはどうしたら良いのでしょうか？ 宜しくお願いします。 以下見つけたマクロです。 Sub test() Dim mydata As String Dim c As Range Dim i As Integer For Each c In Selection mydata = "" For i = 1 To Len(c) If Mid(c, i, 1) >= 0 And Mid(c, i, 1) <= 9 Then mydata = mydata & Mid(c, i, 1) End If Next c.Offset(0, 1) = mydata Next End Sub
- 締切済み
- オフィス系ソフト
- ファイルオープン時のマクロが一部実行されない
いつも回答して頂き、ありがとうございます。感謝感謝です。 ファイルオープン時にApplication.Runで３つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか？もしかして、前の２つで『一覧シート』を除外するマクロを実行しているからでしょうか？御指導の程宜しくお願いいたします。 1番目に実行するマクロ Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub ２番目に実行するマクロ Sub 期限の未達と到達を色で分ける() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Long Dim res As Variant For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column If IsDate(ws.Cells(7, c)) Then If ws.Cells(7, c) > Date Then res = 8 Else res = 3 End If Else res = xlNone End If ws.Cells(7, c).Interior.ColorIndex = res Next c End If End If Next End Sub ３番目に実行するマクロ Sub 各シートの情報を一覧へ転記する() Dim d As Integer Dim retu As Integer d = 3 Do While Cells(d, 2).Value <> "" With Worksheets(Worksheets("一覧").Cells(d, 2).Value) .Activate retu = .Range("IV7").End(xlToLeft).Column .Range(Cells(7, 3), Cells(7, retu)).Copy End With With Worksheets("一覧") .Activate Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With d = d + 1 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルでマクロを使った保存の件で？
以前 エクセルのセルの中身をhtmlファイルで簡単に保存させたい？と言う質問した者です。 http://oshiete1.goo.ne.jp/qa3616400.html そこで以下のようなコードを教えてもらいました。 Sub htmlコピー() Dim c As Range Dim s As String, TmpS As String Dim myF As Integer On Error Resume Next For Each c In Range("A1").CurrentRegion.Resize(, 1) If c.Value <> "" Then s = Trim(c.Value) TmpS = Right(s, Len(s) - InStrRev(s, ".") + 1) If TmpS <> ".htm" And TmpS <> ".html" Then s = s & ".html" End If myF = FreeFile Open ThisWorkbook.Path & "\" & s For Output As #myF Print #myF, Replace(c.Offset(, 1).Value, vbLf, vbCrLf) Close #myF If Err.Number Then Err.Clear MsgBox c.Address & c.Value Exit Sub End If End If Next End Sub 今回の質問 上記の場合はhtmlファイルがエクセルのファイルと同じ場所にできます。 これを、もう1つ下の階層（フォルダを新たに作って）に入れる場合はどの辺りをいじればいいのでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセルの簡単なマクロ機能を追加したいのです
既存のエクセルマクロ（Sub チェック()以下です）に下記の内容のマクロを付け足したいです。 教えていただけないでしょうか。 付け足したい条件です： Sheet2のC列に 0 があれば Sheet1のB列に 愛 と（[太字]でセルの背景色を[灰色25%]にして）入れたいです 恐れ入りますがご存じの方がいらっしゃりましたら教えていただきたく何卒よろしくお願いいたします。 ----------------------------------------------- Sub チェック() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If c2.Offset(, 1).Value = "" Then c1.Offset(, 1).Interior.ColorIndex = 3 Else c1.Offset(, 1).Value = c2.Offset(, 1).Value End If myCt = myCt + 1 End If Next c2 If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub
- 締切済み
- その他MS Office製品
- エクセルのマクロで
お世話になります 下記のマクロで実行した所 １００まで書式設定で保護、ロックしたいのですが b3：l3はロックするものの ４行目以降はロックしません どうしたらいいでしょうか もう１つ、このシートはいつもｃ３からはじめたいのですが If ActiveCell.Value >= "" Then の部分はどうしたらいいでしょうか よろしくおねがいいたします 初心者でバカな質問ですみません Sub マクロ１() Dim i As Integer For i = 1 To 100 If ActiveCell.Value >= "" Then Range("B3:l3").Select Selection.Locked = True Selection.FormulaHidden = False End If ActiveCell.Offset(1, 0).Select Next End Sub
- ベストアンサー
- Visual Basic
- 既存のマクロを他のエクセルファイルで使用したい
下記のマクロを使おうと思うと、 このマクロがついたファイルを開いて 他のエクセルファイルを開くのですが使えません。 使おうとするとマクロのついたファイルに戻ってしまいます。 Sub test01() Dim ws As Worksheet For Each ws In Worksheets If ws.Name = "統合シート" Then Else ws.Activate d = ws.Range("A65535").End(xlUp).Row ws.Range(Cells(1, "A"), Cells(d, "C")).Copy Sheets("統合シート").Activate Sheets("統合シート").Range("A65535").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste End If Next End Sub どこを変えればよいのでしょうか。 教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- マクロで色が同じになるように設定したい
こんにちは。 現在マクロに挑戦中なのですが、一点分からず戸惑っています。 お分かりになる方教えてください。 下記のマクロを書きました。 Sheet2のセルに数字を入れることによってSheet1のセルの色が変わるようにしています。 25以上の数字は全て青（カラー番号5）表示にしたいのですが、どのように記したら良のか教えてください。 --------------------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim iColors As Variant Dim i As Integer Dim j As Integer iColors = Array(36, 20, 24, 37, 40, 39, 17, 22, 45, 43, 28, 6, 4, 41, 18, 47, 50, 46, 10, 7, 3, 21, 9, 5) For Each c In Target If c.Value <> "" Then If IsNumeric(c.Value) Then i = c.Value If i > 0 And i < 25 Then j = iColors(i - 1) Else j = 2 End If End If End If i = c.Row If i > 2 And j > 0 Then Worksheets("Sheet1").Range("B3:K6").Cells(i - 3).Interior.ColorIndex = j End If Next c End Sub --------------------------------------------------------------- お分かりになる方、宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- Excel マクロ ファイル名取得について
Excel マクロ ファイル名取得について 特定のフォルダにあるファイルのファイル名を Excelに一覧として作成します。 下記マクロで実現できたのですが、フォルダでファイルを 「詳細」で並べて上から順番にB列に反映することは 可能でしょうか。 ご回答お待ちしております。 Sub fileName() Dim MyF As String Dim myRow As Long 'ファイル名の取得 myRow = 2 MyF = Dir(ThisWorkbook.Path & "\*") If MyF <> "" Then Do Until MyF = "" Cells(myRow, "B").Value = MyF 'ファイル名 MyF = Dir() myRow = myRow + 1 Loop End If End Sub
- ベストアンサー
- その他MS Office製品
お礼
ありがとうございます。 明日出社後、早速ご呈示いただいた回避方法を試してみたいと思います。そして質問締切を改めてさせてもらいます。