エクセルマクロのBeforSave機能について

前へ 次へ
このQ&Aのポイント
  • エクセルマクロのBeforSave機能で上書き保存するとマイクロソフトに報告する旨のエラーメッセージが出るとのこと。
  • エラー後に報告「する・しない」で自動復帰した後にそのまま上書き保存すると成功するが、少しでも変更を加えると再度同じエラーが発生する。
  • 具体的な原因は不明であり、初めてこの機能を使うため間違いがあるかもしれないとのこと。
回答を見る
  • ベストアンサー

エクセルマクロ　BeforSave機能

ThisWorkbook の Workbook BeforSaveに以下のようにセットして上書き保存すると マイクロソフトに報告する旨のエラーメッセージが出ます。 自ら初めてこの機能を使うのですが、どこがどう間違っているのでしょうか？ エラー後に報告「する・しない」で自動復帰した後にそのまま上書き保存すると 何もおこらず上書きできますが、少しでも変更を加えると再度同じエラーとなります。 よろしくお願いします。 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim IptA As String, rev As String IptA = Cells(3, 13).Value rev = Cells(8, 13).Value If SaveAsUI = False Then Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:\000\" & IptA & "報告" & rev & ".xls", FileFormat:= _ xlNormal, ReadOnlyRecommended:=False _ , CreateBackup:=False End If End Sub

  • OKBob
  • お礼率94% (97/103)

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

  • ベストアンサー
  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.1

Workbook_BeforSaveイベントはブックが保存されると発生します。 なのでその中でまたブックを保存しようとしているので またWorkbook_BeforSaveイベントが発生してループ してるのではないでしょうか？

OKBob
質問者

お礼

迅速に回答頂きましてありがとうございます。 なるほど！確かに考えられますね。 ビフォーセイブなので確かに二回セイブする事になりますね。 もう少しいじって確認してみます。

OKBob
質問者

補足

確認できました。 saveをcloseでやってみたところ、エラーなしで閉じましたので saveが原因だったようです。 今までの感覚だと問題ないように感じていたのですが・・・ ありがとうございました！

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. その他MS Office製品

関連するQ&A

  • Excelでシート名と最終更新日を自動表示したい

    Excelを使って （１）セルA1に入れた名目をシート名にし （２）セルH1には、最終更新日を自動で入れたいです。 調べた結果、 シート名を右クリックして「コードの表示」から （１）は Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub を入れてうまくいきましたが、 （２）は Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 　If ThisWorkbook.Saved = False Then 　　Worksheets("Sheet1").Range("H1").Value = Date 　End If End Sub を入れてみましたが（←調べましたもの） うまくいきませんでした。 単純に、 Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 　If ThisWorkbook.Saved = False Then 　　Worksheets("Sheet1").Range("H1").Value = Date 　End If End Sub とつなげて入れるのではだめなんでしょうか？ それとも、（２）の何かが間違っていますか？ ご教授願います。

  • エクセルVBAにて保存するとき

    Private Sub Workbook_BeforeClose(Cancel As Boolean) If MsgBox("エクセルを終了してもよろしいですか？", vbYesNo) = vbNo Then Cancel = True Exit Sub End If Application.DisplayAlerts = False Application.Quit End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) MsgBox "そのボタンでは保存できません。" & vbCrLf & _ "雛形は残しておきましょう" & vbCrLf & _ "" & vbCrLf & _ "ツールバーの「マクロなし出力」から保存できます。" Cancel = True End Sub という二つのマクロをThisworkbookにいれてあるんですが、 この二つを有効（今は2つ目を'でコメント状態にしてあるので保存可）にすると保存できなくて困っています。 二つを有効にした時はどのようにほぞんすればいいですか？

  • エクセルのマクロで複数セル指定は？

    以前（7月22日　質問No.936181）の質問でご回答を頂いたマクロなんですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim MyData As String Dim i As Integer Dim ImaNanji As String Dim SakkiNanji As String Dim ImaNanpun As String Dim SakkiNanpun As String SakkiNanpun = Cells(2, 3).Value ImaNanji = Cells(1, 3).Value ImaNanpun = Mid(ImaNanji, Len(ImaNanji) - 4, 2) If ImaNanpun <> SakkiNanpun Then Application.EnableEvents = False For i = 10 To 2 Step -1 MyData = Cells(i - 1, 2).Value Cells(i, 2).Value = MyData Next i MyData = Cells(1, 1).Value Cells(1, 2).Value = MyData Cells(2, 3).Value = ImaNanpun Application.EnableEvents = True End If End Sub A1のデータをB1からB10に一分おきにつぎつぎに書き込むというものなんですが、ひとつのセルではなく複数のセル（例えばA1からA30の30個のセル）をいっぺんに書き込むようにしたいのですが可能でしょうか？ よろしくお願いします。

  • VBAでWorkbook_BeforeSaveイベントで質問

    Workbook_BeforeSaveイベントである条件に達していればExcelファイルを終了したくないのですがどうすればよいでしょうか？ WindowsXP ProSP2、Excel2000 コード例） Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) dim flg as boolean if flg=true then exit sub end if End Sub

  • エクセル　マクロ　教えてください。

    sheet１に　（a1=No.　b1=月日　C1=項目　d1=収入　e1=支出　f1=摘要　G1=店名）項目を作りそれらをユーザーフォームを作り入力したいです。 この記述では上手く動けません。教えてください。 Private Sub CommandButton1_Click() Dim r As Long, 最終行 As Long, 項目行 As Long Dim re As String r = textboxs1.Value + 10 最終行 = Worksheets("入力").Range("B65536").End(xlUp).Row If r <= 最終行 Then re = MsgBox("訂正" & " " & "すでにデータが入力されています。" & Chr(13) & _ Chr(13) & "データを置き換えます。　本当に良いですか?　", _ Buttons:=vbYesNo + vbExclamation, Title:="注意!!") If re = vbYes Then With Worksheets("入力") .Cells(r, 2).Activate .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = ComboBox2.Value End With データクリア Exit Sub End If データクリア Exit Sub End If If r >= 最終行 + 1 Then r = 最終行 + 1 End If With Worksheets("入力") .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = CBomboox2.Value End With データクリア End Sub r = データNo + 10 With Worksheets("入力") .Activate .Cells(r, 2).Select TBox1.Value = .Cells(r, 1).Value TBox2.Value = .Cells(r, 2).Value ComboBox1.Value = .Cells(r, 3).Value TBox3.Value = Format(.Cells(r, 4).Value, "###,###") TBox4.Value = Format(.Cells(r, 5).Value, "###,###") TBox5.Value = .Cells(r, 6).Value ComboBox2.Value = .Cells(r, 7).Value End With Exit Sub End If If データNo > 最終行 - 10 Then データNo = 最終行 - 9 TBoxNo.Value = データNo データクリア End If End Sub

  • 下記のマクロをもっと早くするには？

    下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロを動かすと、大体３秒に１つのURLを調べるくらいの早さです。 もっと早く調べられるようにするには、どのような記述にすればできるでしょうか？ また、エクセルの他の設定で、マクロを早くできたりしますか？ よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub

  • エクセルで１つのマクロを複数のシートに適用したい

    いつもお世話になっております。 以前ここで入力セルはファイル保存時に自動で保護かかるように、下記のコードを教わって便利に使い始めたのでですが、同じBookの複数のシート、あるいは一括で全てのシートで有効にしたいのですが。（この機能をデフォルトで選択機能にしていないのはおかしい位に思い始めています。） シート毎に範囲名を指定して、This Workbookにマクロを登録する必要があるのでしょうか？ Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Const MyPassword = "" 'パスワード（省略可） Dim RowCnt As Long Dim ColCnt As Long Dim MyCell As Range With ThisWorkbook.Sheets(1) .Unprotect Password:=MyPassword For Each MyCell In Range("保護範囲") If MyCell.Value <> "" Then MyCell.Locked = True Else MyCell.Locked = False End If Next MyCell .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _ Password:=MyPassword End With End Sub

  • エクセルのマクロを有効にしないと表示しないようにする方法

    エクセルでマクロを有効にしないと、シートが表示されないように設定したいのですが、下記の様に(ほかの方の投稿から)入力すると三行目がエラーになります。素人なので、よくわかりません。どのようにしたら、マクロを有効にしないと全てのシートを表示しないようにできるのでしょうか？　ご教授いただけますでしょうか Private Sub Workbook_BeforeClose(Cancel As Boolean) Sheets(\"Sheet1\").Visible = False Sheets(\"Sheet2\").Visible = False ActiveWorkbook.Protect Password:=\"error123\" End Sub Private Sub Workbook_Open() ActiveWorkbook.Unprotect Password:=\"error123\" Sheets(\"Sheet1\").Visible = True Sheets(\"Sheet2\").Visible = True Sheets(\"Sheet1\").Select End Sub

  • Excel　印刷禁止　マクロの作り方

    毎年の期末で担当者が変わるため、 3/31で印刷を禁止するマクロを作りましたが、 これを応用して初めての使用後、30日で印刷が出来なくなるように しようと思いましたが、なかなか出来ません。どなたか力を貸してください。 Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim D As Integer D = (Now+30) - Now If D <= 0 Then Cancel = True MsgBox "30日経過しましたので、担当者へ連絡してして下さい。印刷できません", 48, " Else Cancel = False Exit Sub End If End Sub 以上　よろしくお願いします。

  • Excel 　VBAのマクロについて

    以下のようなマクロを作りました。 P4に開始番号P6に終わりの番号があるのですが、P4＝P6、つまり、一つだけのシートを作成する分には問題なく動きます。しかしP4に1、P6に5と範囲を増やすとエラーが出て動きません。どこをなおしたらよろしいでしょうか？ Option Explicit Sub 一括() Dim I As Worksheet Dim SheetName As String Dim Prompt As String Dim Col As Integer Dim Cell As Range Dim Row As Long Dim hani As Long For hani = Range("P4").Value To Range("P6").Value Set I = ActiveSheet SheetName = Cells(hani + 4, "K").Value & "(" & Cells(hani + 4, "B") & ")" Prompt = SheetName & "が存在します。" Sheets("基本シート").Copy After:=Sheets("基本シート") On Error GoTo 100 ActiveSheet.Name = SheetName On Error GoTo 0 Range("X3") = I.Cells(hani + 4, "B") Range("E8") = I.Cells(hani + 4, "C") Range("A13") = I.Cells(hani + 4, "D") For Col = 0 To 8 Step 4 Set Cell = I.Cells(hani + 4, "D").Offset(, Col) If Cell > 0 Then Prompt = "該当する日付がありません。" & Cell.Address On Error GoTo 100 Row = WorksheetFunction.Match(Cell, [A:A], 0) On Error GoTo 0 Cells(Row, "E") = I.Cells(hani + 4, "E").Offset(, Col) Cells(Row, "H") = I.Cells(hani + 4, "F").Offset(, Col) If Col < 8 Then Cells(Row, "Y") = I.Cells(hani + 4, "G").Offset(, Col) End If End If Next Col Next hani End 100 If Err <> 1004 Then Error Err End End If MsgBox Prompt, vbCritical Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True Sheets(1).Select End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する