Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7全般 : Excel 2016)
マクロ実行後に再度開くと回復を強要され、ファイルが壊れている
投稿日時: 19/01/08 11:26:10
投稿者: mcx32503

Workbook_Open、Worksheet_Activate、Worksheet_SelectionChange、ActiveXのボタン等のイベント処理を含むブックでイベント処理を含む実行を行った後、上書き保存。再度、ブックを開くと以下の様に修復を強要され、開いて見るとWorksheetのマクロは元のシートに残るものの、シート自体は新しく作成されたシートに移動し、列幅はディフォルトの列幅に、元のシートに作成してあったActiveXのボタンはなくなる等、ブックは壊れてしまいます。
 
再度開いた時に表示されるダイアログ:
'xxxx.xlms'の一部の内容に問題が見つかりました。可能な限り内容を回復しますか?ブックの発行元が信頼できる場合は、[はい]をクリックして下さい。
はいをクリック:
読み取れなかった内容を修復または削除することより、ファイルを開くことができました。
ちなみにExcelのバージョンは以下の通りです。
 
Microsoft Office 365 ProPlus バージョン1708(ビルド 8431.2316 クイック実行)
問題の回避方法や、情報等がおありであれば、提供願えませんか?
 
宜しくお願いします。

回答
投稿日時: 19/01/08 11:44:59
投稿者: WinArrow
投稿者のウェブサイトに移動

見当違いならば、スキップしてください。
 
上書き保存のヶ所のコードを掲示してみてもらえますか?

投稿日時: 19/01/08 13:16:28
投稿者: mcx32503

上書き保存はマクロを定義してあるブックで、マクロで保存しているのではなく、手操作で「ファイル」メニューの「上書き保存」です。
 
宜しくお願いします。

回答
投稿日時: 19/01/08 13:23:45
投稿者: WinArrow
投稿者のウェブサイトに移動

おそらく、入力ミスと思いますが
>'xxxx.xlms'の一部の内容に問題が見つかりました。
このメッセージの中の拡張子は、ダイアログに表示されている通りですか?
 
また、手操作の「上書き保存」は、「名前を付けて保存」ということはありませんか?

投稿日時: 19/01/08 13:36:44
投稿者: mcx32503

マクロ全体だと長いので、関係ありそうな部分をアップします。ブックは壊れてしまうので何度も作り直してテストしていますが、いつも同じメッセージで同じ壊れ方をします。
Windows7、Office 365 ProPlus共に32ビットです。
 
Dim current_workbook As Workbook
Dim current_worksheet As Worksheet
Dim current_row As Long
Dim current_column As Long
 
Private Sub Worksheet_Activate()
    Open_Workbooks_in_List
    ThisWorkbook.Activate
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If Application.CutCopyMode <> False Or IsArray(Target.Value) Or IsNull(Target.Value) Then
        GoTo EXIT_LABEL
    End If
    current_row = Target.Row
    current_column = Target.Column
    Select Case current_column
        Case Column_Number("C"), Column_Number("F")
            Put_Valid_Workbooks current_row, current_column ' データの入力規則設定 ワークブック
        Case Column_Number("D"), Column_Number("G")
            Put_Valid_Worksheets current_row, current_column ' データの入力規則設定 ワークシート
        Case Column_Number("E"), Column_Number("H")
            Activate_Worksheet current_row, current_column ' ワークシートのアクティベイト
    End Select
EXIT_LABEL:
    Application.EnableEvents = True
End Sub
 
Sub Put_Valid_Workbooks(r As Long, c As Long) ' データの入力規則設定 ワークブック
    Dim wb As Workbook, name_list As String
    For Each wb In Workbooks ' リストの作成
        If wb.name <> ThisWorkbook.name Then
            If name_list <> "" Then
                name_list = name_list & ","
            End If
            name_list = name_list & wb.name
        End If
    Next wb
    If name_list <> "" Then
        Valid_List_String Me, r, c, name_list
    Else
        Valid_Any_Value Me, r, c
    End If
End Sub
 
Sub Put_Valid_Worksheets(r As Long, c As Long) ' データの入力規則設定 ワークシート
    Dim ws As Worksheet, book_name As String, name_list As String
    book_name = Cells(r, c - 1).Value
    If Exist_Workbook(book_name) Then
        For Each ws In Workbooks(book_name).Worksheets ' リストの作成
            If name_list <> "" Then
                name_list = name_list & ","
            End If
            name_list = name_list & ws.name
        Next ws
        Valid_List_String Me, r, c, name_list
    Else
        Valid_Any_Value Me, r, c
    End If
End Sub
 
Sub Activate_Worksheet(r As Long, c As Long) ' ワークシートのアクティベイト
    Dim book_name As String, sheet_name As String
    book_name = Cells(r, c - 2).Value
    sheet_name = Cells(r, c - 1).Value
    If Exist_Workbook(book_name) And Exist_Worksheet(Workbooks(book_name), sheet_name) Then
        Set current_workbook = Workbooks(book_name)
        Set current_worksheet = current_workbook.Worksheets(sheet_name)
        current_workbook.Activate
        current_worksheet.Select
    End If
End Sub
 
Private Sub Paste_Address_Click() ' アドレスの取得ボタンで実行
    current_workbook.Activate
    current_worksheet.Select
    If TypeName(Selection) = "Range" Then
        Cells(current_row, current_column).Value = Replace(Selection.Address, "$", "")
    End If
End Sub
 
Private Sub Perform_Copy_Click() ' コピーボタンで実行
    Perform_Copy_Procedure
End Sub
 
Function Exist_Workbook(name As String) As Boolean
' シートがあるかどうか確認する
' name: ワークブックの名前
    Dim wb As Workbook
    Exist_Workbook = False
    For Each wb In Workbooks
        If wb.name = name Then
            Exist_Workbook = True
            Exit For
        End If
    Next wb
End Function
 
Function Exist_Worksheet(wb As Workbook, name As String) As Boolean
' シートがあるかどうか確認する
' wb: ワークブック
' name: ワークシートの名前
    Dim ws As Worksheet
    Exist_Worksheet = False
    For Each ws In wb.Worksheets
        If ws.name = name Then
            Exist_Worksheet = True
            Exit For
        End If
    Next
End Function
 
Sub Valid_List_String(ws As Worksheet, r As Long, c As Long, str As String)
' 入力規則として名前ボックスを指定する
' ws: ワークシート
' r: 指定する列
' c: 指定する行
' str: 入力規則
    With ws.Cells(r, c).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=str
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = "リストから選択して下さい"
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
End Sub
 
Sub Valid_Any_Value(ws As Worksheet, r As Long, c As Long)
' 入力規則として名前ボックスを指定する
' ws: ワークシート
' r: 指定する列
' c: 指定する行
    With ws.Cells(r, c).Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = "リストから選択して下さい"
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
End Sub

投稿日時: 19/01/08 13:44:00
投稿者: mcx32503

・ブックの拡張子は「.xlms」ではなく「.xlsm」でした。私の入力ミスです。
・「名前を付けて保存」ではなく、「上書き保存」です。
 
宜しくお願いします。

回答
投稿日時: 19/01/08 14:18:12
投稿者: WinArrow
投稿者のウェブサイトに移動

保存したブックが開けない
という症状は、保存時の操作に問題があると思います。
VBAではなく手操作で保存しているということで、
他人には、わかりかねます。

投稿日時: 19/01/08 16:24:46
投稿者: mcx32503

皆様、お世話になりました。
 
たぶん、原因は特定できました。ありがとうございます。
 
先程アップしたマクロのリストにあるPut_Valid_Worksheetsはブックの中に含まれるシートの一覧(データの入力規則のリストの元の値)を作成し、該当セルにデータの入力規則を設定するものです。
今回のテストに使ったブックはかなり多くのシートを含んでいたために元の値を保持する領域を超えてしまったため、ブックが破壊された様です。
 
多くのシートを含むブックに対応するためにはシートの一覧をどこかのシート上にに作成し、元の値にはそのアドレスを指定する方法をとる必要がある様です。
 
前にも同様の問題があり、その様な対応をしたことを忘れてました。