How can I save a Word document as the value in a table? I've tried this and get a "Type mismatch" error:
Sub saveas_cell()
ActiveDocument.SaveAs FileName:= _
"c:\mydocuments" ActiveDocument.Tables(1).Cell(1, 2) & ".doc"
End Sub
I've also tried an object reference (activedocument.table1.("text3"))
Thanks for the help!
You get an error message because Table.Cell does not return a string, but a cell object. Instead, use this:
"c:\mydocuments" ActiveDocument.Tables(1).Cell(1, 2).Shape.TextFrame.TextRange.Text & ".doc"
You can find more information here.
Related
I am trying to use VBA in an open .docm file to open a 2nd read only .docx file and then insert -> object -> text from file (a 3rd read only .docx stored within the same folder).
The below code correctly opens and merges the two files but when it comes to saving the output it returns a Run-Time 13 “mismatch” error. My limited understanding leads me to believe that at the point where I am saving, the active document reference is still the original .docm and it is the .docx designation that then causes the conflict.
I am really struggling to manage the active document reference to avoid this. Presumably I am missing something very simple, all assistance is very gratefully received.
Documents.Open ActiveDocument.Path & "\DocA.docx", Visible:=True
Selection.InsertFile FileName:=ActiveDocument.Path & "\DocB.docx", Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
ActiveDocument.SaveAs2 "C:\Users\" & Environ("UserName") & "\DocC" & ".docx", FileFormat:= _
wdFormatXMLDocument
ActiveWindow.Close
Putting flesh on John Korchok's comment:
Sub deleteme3()
Dim oldDoc As Document
Set oldDoc = Documents.Open(ActiveDocument.Path & "\DocA.docx", Visible:=True)
oldDoc.Activate
selection.Collapse Direction:=wdCollapseEnd 'to insert at end of document
selection.Range.InsertBreak Type:=wdPageBreak
Selection.EndKey Unit:=wdStory
Selection.InsertFile FileName:=ActiveDocument.Path & "\DocB.docx", range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
oldDoc.SaveAs2 "C:\Users\" & Environ("UserName") & "\DocC" & ".docx", FileFormat:= _
wdFormatXMLDocument
oldDoc.Close
Set oldDoc = Nothing
End Sub
Note this puts the inserted document at the end of the original document. You may want to use a next-page section break instead if there is header/footer differentiation. If you need that, please comment and I will include it.
There are a number of break types. Here is the enumeration of all of them if you are interested. The following types create a page break of one sort or another:
wdPageBreak (the default)
wdSectionBreakNextPage
wdSectionBreakOddPage (starts section on next odd-numbered page - good for chapters)
wdSectionBreakEvenPage (starts section on next even-numbered page - rarely used)
If wanting to preserve headers and footers additional code would be needed.
(Every section in a Word document has three headers and three footers, even if they are not displayed or used.)
' Break Link to Previous in newly added section for all of the headers and footers
Dim oHeaderFooter As HeaderFooter
Dim iCounter As Long
Let iCounter = ActiveDocument.Sections.Count
' break link in headers
For Each oHeaderFooter In ActiveDocument.Sections(iCounter).Headers
Let oHeaderFooter.LinkToPrevious = False
Next oHeaderFooter
' repeat for footers
For Each oHeaderFooter In ActiveDocument.Sections(iCounter).Footers
Let oHeaderFooter.LinkToPrevious = False
Next oHeaderFooter
I am using the below mentioned code to print a sheet. My task is complete, however I get the error message stating "Run-time error '-2147024773 (8007007b)': Document not saved."
Also, in the below code, can I add a text to the file name (other than cell A1 text?). I would like the file name to be name (which is on cell A1) and add a text "- Workpaper" in the end.
Can some one help?
Sub PrintFile()
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Foldername\" & Range("A1").Text, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End Sub
Try changing "Range("A1").Text" to "Range("A1").Value"
Text vs Value
Also, you should be checking for a valid filename prior to using the value.
Function ValidateFileName(ByVal name As String) As Boolean
' Check for nothing in filename.
If name Is Nothing Then
ValidateFileName = False
End If
' Determines if there are bad characters.
For Each badChar As Char In System.IO.Path.GetInvalidPathChars
If InStr(name, badChar) > 0 Then
ValidateFileName = False
End If
Next
' If Name passes all above tests Return True.
ValidateFileName = True
End Function
First of all type e.g. "test" into A1 cell - probably there is something wrong with the filename. You can also use Excels's data validation or some VBA code to sanitizate the filename. You can also add some check if directory exists to make sure it isn't a problem.
Sub PrintFile()
' check if folder exists
If Dir("C:\Foldername\", vbDirectory) = "" Then
MkDir "C:\Foldername\"
End If
' check if name in A1 is not blank
If IsEmpty(Range("A1")) Then
MsgBox "Fill A1 Cell with name of the pdf file first"
Else
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Foldername\" & Range("A1").Value & "- Workpaper", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End If
End Sub
So there is a problem with your path or/and filename. Maybe it is a Mac and C:\ is not proper address?
The reason for this error might be insufficient privileges or any invalid characters in the name of the file.
Could you try to save it in a different drive than C and see if that works?
Replace this line of your code with below line to add -Workpaper at the end of your file name.
Assuming that you're trying to save this in D drive in a temp folder.
Filename:="D:\temp\" & Range("A1").Text & "-Workpaper", _
In my Workbook i have a CommandButton which opens a New Workbook and adds a CommandButton.
My Problem now is, that i always get the run time Error 9 when i click the Button.
This is my Code for the new Workbook:
Sub PM_Controlling_Click()
Dim relativePath As String
Workbooks.Add
relativeString = ThisWorkbook.Path & "\Test2"
ActiveWorkbook.SaveAs Filename:=relativeString & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Call Import_UserForm
Call Import_Modul
Call Working_Structur
End Sub
This i my Import Code:
Sub Import_UserForm
Workbooks("Test2.xlsm").VBProject.VBComponents.Import Filename:= _
"C:\Users\Desktop\Code_Samples\UserForm1.frm"
End Sub
Sub Import_Modul
Workbooks("Test2.xlsm").VBProject.VBComponents.Import Filename:= _
"C:\Users\Desktop\Code_Samples\AddAZ.bas"
End Sub
And here is my Working_Structur Modul where i try to add the Button with Code:
Sub Working_Structur()
Dim btn1 As Object
Dim Code As String
Set btn1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=105, Top:=175, Width:=50, Height:=25)
ActiveSheet.OLEObjects(1).Object.Caption = "Watch"
btn1.Name = "Watch AZ"
Code = "Sub Watch_Click()" & vbCrLf
Code = Code & "Call Watch_AZ_Sheet" & vbCrLf
Code = Code & "End Sub"
' Next Part causes the run time error
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, Code
End With
I hope someone can help me to solve this problem.
EDIT:
The error appears in Sub Working_Structure, the Line
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
causes the error.
My understanding is that Subscript out of range runtime error 9 is thrown when part of what is being referenced does not exist or is undefined.
Maybe the cause of the error is ActiveSheet.Name is not being the VBAComponent name
Please check the names of the VBA components matching your sheet actual name.
Below example throws error since the sheet name ActualSheetName is not the component name Sheet1
Renaming the Component name will fix the issue. Something like :
Update:
You can directly use the codename property of worksheet in the code.
Worksheet.CodeName MSDN
With ActiveWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule
I use a For ... Next loop to insert pictures to an Excel worksheet. The name of the picture comes from column B. Sometimes, there is no corresponding picture on the hard disk. In such cases, Excel will throw an error message and stop running the codes. First, I tried "On Error Resume Next". This is not good because all the codes after the error occurs are executed. So, I tried the following code to try to avoid running codes when the picture is not found. This, however, only catches the first error. Excel still throws an error message ("unable to get the insert property of the pictures class") when the second time a picture is not found. All I want is if an error occurs, Excel would skip the rest of the code and go to the next case. How can this be done? Thanks for any help.
......
On Error GoTo gotoNext
For Each cell In rng
......
Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Pictures.Insert(Path_Prefix & "\" & _
Replace(cell.Value, "/", "-") & ".jpg") 'when the picture is not found, Excel throws an error
......
gotoNext:
Err.Clear
Next
You can quickly check the existence of the image file with the Dir command. It will return the name of the file (hence a returned string length greater than zero) if it is found.
For Each cell In rng
if cbool(len(dir(Path_Prefix & "\" & Replace(cell.Value, "/", "-") & ".jpg"))) then
Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Pictures.Insert(Path_Prefix & "\" & Replace(cell.Value, "/", "-") & ".jpg")
end if
next cell
I need to create a macro to print two sheets and include a custom footer that references several of the cells.
I have tried so many combinations, but I don't know what I am doing wrong. I get the error Object does not support this property or method.
Sub PrintSummarySheet()
' PrintSummarySheet Macro
Sheets("Project Data Input").Select
With ActiveSheet.PageSetup
.CenterFooter = .Range("C6").Text And .Range("F2").Text _
And .Range("F4").Text And .Range("F5").Text
End With
Sheets(Array("Project Data Input", "Project Estimate Summary")).Select
Sheets("Project Data Input").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("INSTRUCTIONS").Select
Sheets("Project Data Input").Select
End Sub
You are using With ActiveSheet.PageSetup but on the next line you are trying to refer to the Worksheet and not the PageSetup by doing .Range(...).
You need to replace .Range(...) by ActiveSheet.Range(...).
The Run-time error 13 Type mismatch occurs because you are using And to concatenate text instead of the concatenation operator &
.Range("C6").Text And .Range("F2").Text _
And .Range("F4").Text And .Range("F5").Text
Should be:
.Range("C6").Text & .Range("F2").Text & _
.Range("F4").Text & .Range("F5").Text