Even after looking through all of similar phrased questions and several search engine results I did not find any answer.
I copy the current word document and change the codebase by removing former modules and rewrite the ThisDocument-component by adding from file. For the context, but most probably skippable:
Public Sub DOCMPublish()
'...msoFileDialogSaveAs...and then...'
Application.Documents.Add ThisDocument.FullName
On Error Resume Next
' unlink fields and finalize content to avoid updates within the archived documents
Dim oFld As field
For Each oFld In ActiveDocument.Fields
oFld.Unlink
Next
' rewrite macros and unload modules
On Error Resume Next
Dim Element As Object
For Each Element In ActiveDocument.VBProject.VBComponents
ActiveDocument.VBProject.VBComponents.Remove Element
Next
rewriteMain ActiveDocument, "ThisDocument", ThisDocument.path & "\Document_Public_DOCM.vba"
' protect content
ActiveDocument.Protect wdAllowOnlyFormFields, Password:="LoremIpsum"
' msoFileDialogSaveAs does not support filetypes, hence forcing extension
DOCMFile = fileSaveName.SelectedItems(1)
DOCMFile = Replace(DOCMFile, ".doc", ".docm")
DOCMFile = Replace(DOCMFile, ".docmx", ".docm")
' the next line saves the copy to your location and name
ActiveDocument.SaveAs2 filename:=DOCMFile, FileFormat:=wdFormatXMLDocumentMacroEnabled
' next line closes the copy leaving you with the original document
ActiveDocument.Close
End Sub
This sub worked properly for that over the last years:
Sub rewriteMain(ByRef Workument, ByVal Module, ByVal Source)
'delete code from ThisDocument/ThisWorkbook
Workument.VBProject.VBComponents.Item(1).CodeModule.DeleteLines 1, Workument.VBProject.VBComponents.Item(1).CodeModule.CountOfLines
'rewrite from file
With Workument.VBProject
.VBComponents(Module).CodeModule.AddFromFile Source
End With
'delete module
Workument.VBProject.VBComponents.Remove Workument.VBProject.VBComponents("Rewrite")
End Sub
The content of Document_Public_DOCM.vba to be imported is
Option Explicit
Private Sub Document_Close()
ThisDocument.Saved = True
End Sub
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim cc As ContentControl
For Each cc In ThisDocument.ContentControls
'checkboxes have no type attribute to check against, therefore the need of _
error handling on checked-property that is checkbox-only in this usecase
On Error Resume Next
ThisDocument.Bookmarks("text" & cc.Tag).Range.Font.Hidden = Not cc.Checked
ThisDocument.Bookmarks("notext" & cc.Tag).Range.Font.Hidden = cc.Checked
Next
End Sub
I can see no problem here, and the modified and saved file doesn't complain later on. But in the meantime i get the compiling error on closing the ActiveDocument after the import and ActiveDocument.SaveAs2. I get no error without closing the file though, but this is not nice for the work environment, messing up the screen.
Often word crashes, sometimes it just results in a state loss. I also tried encoding as utf-8 and iso 8859-1, disabled screen updating but that does not seem to be the solution as well. What am I missing?
Edit:
What I tried further without success:
disabling syntax checking in the editor
On Error Resume Next
Err.Clear
newDoc.EnableEvents = False (after implementing #Алексей-Р suggestion)
excluding deletion of .VBProject.VBComponents names "ThisDocument"
Also explicitly compiling the modified files code expectedly does not raise any errors. Are there any editor settings I am unaware of?
I try to answer it myself, at least this solved the issue in this case:
I open the file with
Set newDOC = Documents.Add(ThisDocument.FullName, True, wdNewBlankDocument, False)
I can only assume that opening the file in a new blank document and not displaying it might prevent the code executing and therefore having issues being replaced at runtime.
Edit:
it worked at first, then it didn't. Still don't know why. The following now seems to be failproof:
Set newDOC = Documents.Add("", True, wdNewBlankDocument, False)
ThisDocument.Content.Copy
dim rng
Set rng = newDoc.Content
rng.Collapse Direction:=wdCollapseEnd
rng.Paste
'clear clipboard, otherwise an annoying msg popy up everytime because huge content is left there from copying
Dim clscb As New DataObject 'object to use the clipboard
clscb.SetText text:=Empty
clscb.PutInClipboard 'put void into clipboard
This solution opens a new blank document and copypasts the content without having macros in the first place. Afterwards I proceed to rewrite the modules as in the initial snippet from the question
Not sure why it worked for #АлексейР with my provided code though. Thanks for caring anyway!
Related
I am creating a Word template that performs a bunch of actions when Document_New is initialised. For example, I am pulling in and applying Custom Document Properties from an XML file in one sub, and referring to them in a second.
I'm trying to add some error handling to close the document with an error message and prevent the rest of the VBA from running, and I can get to the point where the document closes, but the rest of the VBA code continues to execute. Ideally I need to close just this new document (other Word documents may be open on a device) and stop any more processing of VBA.
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
When this is in place, the template seems to close, but the newly created document still exists and the template VBA continues to run.
Is anyone able to suggest a way to close the template and abort the creation of the new document?
EDIT: Including an example of how I'm looking for errors.
In Document_New - I call ValidateProperties that loops through an arrayProps array that stores properties required for the template. Each property in the array is checked using the function CustomDocumentPropertyExists and if that returns false I call the sub ExitFailedValidation. This is the sub I want to call if the template fails a validation test. I want to be able to cleanly close the new document without saving and leave any other Word windows open.
Sub ValidateProperties()
Dim arrayProps(1) As String
Dim i As Long
arrayProps(0) = "prop-doc-blueprint"
arrayProps(1) = "prop-doc-stationery"
For i = 0 To UBound(arrayProps)
If CustomDocumentPropertyExists(arrayProps(i)) = False Then
ExitFailedValidation ("The required custom document property " & arrayProps(i) & " is missing. Please check " & _
"the config.xml file to ensure it is included.")
End If
Next i
End Sub
Sub ExitFailedValidation(Message As String)
MsgBox "The Template failed to load and validate." & vbCrLf & vbCrLf & _
Message, vbCritical, "Error loading template"
MsgBox ThisDocument.Name
MsgBox ActiveDocument.Name
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
The Document_New() is the entrance point in code, so it should handle the tasks that need to be run and take appropriate action should an error occurs or something did not go as expected as in your case.
In order to be able to do that, the tasks it calls must report their status, e.g. completed, failed, something is missing etc.
Therefore, change the ValidateProperties() sub into a function that returns true or false and pass a string to it as an output parameter that will hold the error message if the function fails. If all goes well, it will simply be unused.
The main point of the app. This method decides what happens in the app.
Private Sub Document_New()
Dim errorMessage As String
If Not TryValidateProperties(errorMessage) Then
ExitFailedValidation errorMessage
Exit Sub
End If
'all good - continue
End Sub
The ValidateProperties() sub changed to a method that returns true or false with an optional error message if something is wrong. Since false is the default value of a boolean, exiting the function if a property doesn't exist will return false - no need to set it explicitly.
Private Function TryValidateProperties(ByRef outMessage As String) As Boolean
'...
For i = 0 To UBound(arrayProps)
If Not CustomDocumentPropertyExists(arrayProps(i)) Then
outMessage = "The required custom document property " & arrayProps(i) & " is missing. Please check " & _
"the config.xml file to ensure it is included."
Exit Function
End If
Next i
'all good
TryValidateProperties = True
End Function
Lastly, the helper method for communicating the error. In my opinion, the document shouldn't be closed here, but within the Document_New() method if property validation fails, but I'll leave this with you.
Private Sub ExitFailedValidation(Message As String)
MsgBox Message
End Sub
To add error handling in a method:
Sub T()
On Error GoTo Trap
'main method body
Leave:
'Release any references here, e.g. close db connection, release file handle etc.
Exit Sub
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
This macro (with minor changes, it likely originated on a Stack Exchange site) is fairly popular with authors that need to convert lots of tracked changes to regular text that has been colored blue:
Sub accept_changes()
tempState = ActiveDocument.TrackRevisions
ActiveDocument.TrackRevisions = False
For Each Revision In ActiveDocument.Revisions
Set Change = Revision.Range
Change.Revisions.AcceptAll
Change.Font.Color = 12611584
Next
ActiveDocument.TrackRevisions = tempState
End Sub
However, when using other macros or plug-ins such as Zotero it generates errors such as the following one:
Run-time error '5825': Object has been deleted
On the line with Set Change = Revision.Range, watching the code at debug shows that the Revision variable is of type Variant/Empty and all of the values (e.g., Revision.Range) are set to <Object has been deleted> in the Watches window. The field code encoding in the document at the point where the error occurs is ({ REF Ref87607402 \h \* MERGEFORMAT }).
Based upon stepping through the code this error seems to arise when citations or cross reference codes are inserted into the text, rendering creation of a SSCCE extremely difficult since the error has the properties of a heisenbug. However, for a document with 100's of changes, even being able to just bypass the error to move on to the next error would be useful.
Accordingly, how can you test for a deleted object in VBA, or conversely, bypass a deleted object to move onto the next revision in the document?
This occurs when you loop through a collection to perform an operation that will result in items being deleted from the collection. When you delete the first item the second becomes the new number 1, and the last index is empty (the number of items to process is set when the For Each is processed). This gets repeated with each item you delete. By the time you have processed half the collection the other half no longer exists.
To avoid this, you need to process the collection in reverse.
Sub accept_changes()
tempState = ActiveDocument.TrackRevisions
ActiveDocument.TrackRevisions = False
Dim index As Long, Change As Range
For index = ActiveDocument.Revisions.Count To 1 Step -1
Set Change = ActiveDocument.Revisions(index).Range
Change.Revisions.AcceptAll
Change.Font.Color = 12611584
Next
ActiveDocument.TrackRevisions = tempState
End Sub
You also need to get out of the habit of not declaring variables. It will help you if you add Option Explicit at the top of the code module. This will prevent your code from compiling when you have undeclared variables. To add this automatically to new modules open the VBE and go to Tools | Options. In the Options dialog ensure that Require Variable Declaration is checked.
Also, be careful when naming variables. For Each Revision In ActiveDocument.Revisions is bad practice as Revision is the name of an object in Word's object model.
With a bit of hunting around and viewing of the field codes used by Word, it appears that this error was due to a corrupted field code. There's some evidence in the Microsoft support forum that this might be a known, but infrequent error that can be addressed by showing field codes.
Testing against my document that generated the error, the following macro runs correctly and did not generate any errors.
Option Explicit
Sub accept_changes()
Dim tempState As Boolean, count As Integer, change As Range, thisRevision As Revision
' Check if there is work to do
count = ActiveDocument.Revisions.count
If count = 0 Then
MsgBox "No revisions to process", vbInformation
Exit Sub
End If
' Disable screen updating for performance
Application.ScreenUpdating = False
With ActiveDocument
' Note the current state of revision tracking and disable them
tempState = .TrackRevisions
.TrackRevisions = False
' Show field codes incase any are corrupted
.ActiveWindow.View.ShowFieldCodes = True
' Iterate through each revision, accept them and highlgiht the range in blue
For Each thisRevision In .Revisions
Set change = thisRevision.Range
change.Revisions.AcceptAll
change.Font.Color = 12611584
Next
' Restore application state
.ActiveWindow.View.ShowFieldCodes = False
.TrackRevisions = tempState
End With
' Reenable screen updating
Application.ScreenUpdating = True
' Let the user know we are done
MsgBox "Accpeted " + Str(count) + " revision(s)", vbInformation
End Sub
I have a large, dynamic Word macro with lots of formfields on it. It takes a long time to run, and by far the most time consuming part is clearing all the formfields before mapping them. Right now I'm looping through them and setting them individually = "". I found a quicker way to do it, but it always corrupts the document.
1) Current:
For Each fld In doc.FormFields
If fld.Type = wdFieldFormTextInput And fld.Result <> "" Then
fld.Result = ""
ElseIf fld.Type = wdFieldFormCheckBox Then
fld.CheckBox.Value = False
End If
Next
2) Tried:
ActiveDocument.ResetFormFields
and 3)
Unload Me
in a command button click event
1) Takes at least a minute every time
2) is almost instant but corrupts the document (error saying "Word has encountered a problem. You will not be able to undo this action...")
3) Throws an error- "361: Can't load or unload this object"
I either want 2) to work, or to find any faster way to clear the formfields.
Thanks for your time.
Referring to (2): this is not so much an error message as a warning, and there's no document corruption. Word always loses the Undo list when a document is unprotected, which is what happens behind the scenes with this method.
Two approaches occur to me. One would be to disable alerts, which should suppress the warning. The other would be to emulate the user action of unprotecting, then re-protecting without saving the current form field entries.
To suppress the warning (this won't affect true error messages):
Application.DisplayAlerts = wdAlertsNone
To unprotect then reprotect the document without saving user input:
Sub UnprotectReprotectToResetFields()
Dim doc As Word.Document
Set doc = ActiveDocument
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect
End If
doc.Protect wdAllowOnlyFormFields, False
End Sub
I made a worksheet for the company I work for to help with pricing out custom designs. A few months ago I made a macro that can save the parts to a text file that can be pulled from at a later date if we wanted to quote out the same design. Everything was working perfectly, until one day I go to open it up and got the error message
We found a problem with some content in 'File.xlsm'. Do you want us to try
to recover as much as we can?
When I click yes, it then comes up with the worksheet the macro was on completely un-formatted and says it could only open the file by repairing or removing the following part
Repaired Part: /xl/worksheets/sheet3.xml part.
This is weird because the only xml code I use is just to create a drop-down menu when the saved design names are loaded. Nothing has changed since the final revision of the code other than the amount of designs that have been saved. The boxes I had as buttons tied to macros have been deleted and none of the code for this sheet works. What it shows when I view the code now is Sheet_Thumbnails
All other macros work, the other sheets are fully functional. When I try and run the code on this sheet I get
Run-time error '429':
ActiveX component can't create object
This has to be when compiling because I can't even debug where this is happening. The best answer I get when I look this error up is that I am not using the "New" keyword when calling a file or object from somewhere else. But I have looked through my code and don't see anywhere that applies. Luckily a co-worker saved a copy off our server to her computer so I have a backup, but when I open this and run the macros then save and re-open, the same crash happens.
Here is the code with xml:
Sub MakeList(ByRef r As Range, ByRef Config As String)
r.Clear
If Not Config = "" Then
r.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Config
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End Sub
Can anyone help me? I am at a total loss for why this has happened and why it keeps happening. Is it the validation part? Why would it happen after working for months?
Thank you in advance.
EDIT 1
Exporting all of the code and creating a new workbook did not solve the problem.
Thanks to Profex, the problem has been found and is in the validation. Essentially one of my lists was too long. The formula used in validation is not supposed to be beyond 255 characters. Even though Excel doesn't give any warning on this, when I would create the drop down menus, although it would populate each item from the list, after saving closing and re-opening, apparently this would corrupt the coded sheet. So now the question lies with how to add values into a drop-down menu without clearing and re-initializing with a longer list. Should I post a new question for that?
In Excel, Cell Validation Lists have a 8191 character limit (which is way too long for a user to pick from anyway).
Anything over 254 characters will corrupt the file upon save/re-open.
Here is something similar to what I have done in the past to create Dynamic Validations lists:
It uses your MakeList() subroutine, and requires another GetList() function to get the validation list for the specified cell.
Since this code is in the Workbook module, I also added another function called IsSheetTheOneICareAboutWithValidations(). If you use the WorksSheet_SelectionChange Event from in a specific sheet module, this isn't required; but you would have to change the scope of m_ValidationCell and m_ValidationList to be Public.
This code is untested and goes in the ThisWorkbook module:
Option Explicit
Private m_ValidationCell As Excel.Range
Private m_ValidationList As String
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not m_ValidationCell Is Nothing Then
m_ValidationList = m_ValidationCell.Validation.Value
m_ValidationCell.Validation.Delete
End If
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If m_ValidationList <> vbNullString Then
With m_ValidationCell.Validation
.Add Type:=xlValidateList, Formula1:=ValidationList
End With
m_ValidationList = vbNullString
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not m_ValidationCell Is Nothing Then
m_ValidationCell.Validation.Delete
Set m_ValidationCell = Nothing
End If
If IsSheetTheOneICareAboutWithValidations(Sh) Then
' Since we're changing the Validation each time there is a new Selection;
' It's the Active Cell that matters, not the Target range
' Add a validation list to any cell in column 4, after the header (in row 1).
If ActiveCell.Column = 4 And ActiveCell.Row > 1 Then
List = GetList(ActiveCell)
MakeList ActiveCell, List
' Should probably add this next line to you MakeList() function
Set m_ValidationCell = ActiveCell
End If
End If
End Sub
Private Function GetList(Target As Range) As String
GetList = vbNullString ' or whatever you want
End Function
Private Function IsSheetTheOneICareAboutWithValidations(Sh As Object) As Boolean
IsSheetTheOneICareAboutWithValidations = (Sh.Name = "Pricing")
End Function
Recovery
It looks like you just had a bad save. Sometimes it just corrupts the file and there isn't much you can do, other then hope you have a backup.
Right Click in the Folder > Properties > Previous Versions
If you don't have a backup, it might just help to move everything to a new file.
Create a New Workbook
Select All cells from your first sheet (click above the 1, left of the A)
Press Ctrl+C to Copy
Select All cells in your New Workbook/Sheet
Press Ctrl+V to Paste
Repeat for all Worksheets
On the VB side of things, you can just Drag the Forms/Modules/Classes from the Old file to the New One.
Issue
Did you know that all New Office documents are really just ZIP files...
Go ahead, rename the file to File.xlsm.zip
Inside the file you'll see a folder structure which should have .../xl/worksheets/sheet3.xml
This is what excel is complaining about! That file is either missing or wrong.
Code
I don't know how you're calling Makelist, so I can't verify that the range R that you are passing is valid.
Please remove the Select/Selection from your code. You don't need to select anything in the front end GUI of Excel to access/change the cells. Also you didn't check if R was Nothing.
Sub MakeList(ByRef r As Range, ByRef Config As String)
If Not r Is Nothing then
r.Clear
If Not Config = "" Then
With r.Validation
...
End With
End If
End If
End Sub
I'm a novice self-taught VBA programmer knowing just enough augment Excel/Access files here and there. I have a mysterious 438 error that only popped up when a coworker made a copy of my workbook (Excel 2013 .xlsm) and e-mailed it to someone.
When the file is opened, I get a run time 438 error when setting a variable in a module to a ActiveX combobox on a sheet. If I hit end and rerun the Sub, it works without issue.
Module1:
Option Private Module
Option Explicit
Public EventsDisabled As Boolean
Public ListBox1Index As Integer
Public cMyListBox As MSForms.ListBox
Public cMyComboBox As MSForms.Combobox
Public WB As String
Sub InitVariables()
Stop '//for breaking the code on Excel open.
WB = ActiveWorkbook.Name
Set cMyListBox = Workbooks(WB).Worksheets("Equipment").Listbox1
Set cMyComboBox = Workbooks(WB).Worksheets("Equipment").Combobox1 '//438 here
End Sub
Sub PopulateListBox() '//Fills list box with data from data sheet + 1 blank
Dim y As Integer
If WB = "" Then InitVariables
ListBox1Index = cMyListBox.ListBoxIndex
With Workbooks(WB).Worksheets("Equipment-Data")
y = 3
Do While .Cells(y, 1).Value <> ""
y = y + 1
Loop
End With
Call DisableEvents
cMyListBox.ListFillRange = "'Equipment-Data'!A3:A" & y
cMyListBox.ListIndex = ListBox1Index
cMyListBox.Height = 549.75
Call EnableEvents
End Sub
...
PopulateListBox is called in the Worksheet_activate sub of the "Equipment" sheet.
All my code was in the "Equipment" sheet until I read that was bad form and moved it to Module1. That broke all my listbox and combobox code but based on the answer in this post I created the InitVariables Sub and got it working.
I initially called InitVariables once from Workbook_open but added the If WB="" check after WB lost its value once clicking around different workbooks that were open at the same time. I'm sure this stems from improper use of Private/Public/Global variables (I've tried understanding this with limited success) but I don't think this is related to the 438 error.
On startup (opening Excel file from Windows Explorer with no instances of Excel running), if I add a watch to cMyComboBox after the code breaks at "Stop" and then step through (F8), it sets cMyComboBox properly without error. Context of the watch does not seem to affect whether or not it prevents the error. If I just start stepping or comment out the Stop line then I get the 438 when it goes to set cMyComboBox.
If I add "On Error Resume Next" to the InitVariables then I don't error and the project "works" because InitVariables ends up getting called again before the cMyComboBox variable is needed and the sub always seems to work fine the second time. I'd rather avoid yet-another-hack in my code if I can.
Matt
Instead of On Error Resume Next, implement an actual handler - here this would be a "retry loop"; we prevent an infinite loop by capping the number of attempts:
Sub InitVariables()
Dim attempts As Long
On Error GoTo ErrHandler
DoEvents ' give Excel a shot at finishing whatever it's doing
Set cMyListBox = ActiveWorkbook.Worksheets("Equipment").Listbox1
Set cMyComboBox = ActiveWorkbook.Worksheets("Equipment").Combobox1
On Error GoTo 0
Exit Sub
ErrHandler:
If Err.Number = 438 And attempts < 10 Then
DoEvents
attempts = attempts + 1
Resume 'try the assignment again
Else
Err.Raise Err.Number 'otherwise rethrow the error
End If
End Sub
Resume resumes execution on the exact same instruction that caused the error.
Notice the DoEvents calls; this makes Excel resume doing whatever it was doing, e.g. loading ActiveX controls; it's possible the DoEvents alone fixes the problem and that the whole retry loop becomes moot, too... but better safe than sorry.
That said, I'd seriously consider another design that doesn't rely so heavily on what appears to be global variables and state.