I need help with this macro. Every time I run it, I get the error below. I thought it was a simple macro that I could have anybody on my team use to make it take a less time than they were taking to manually create this PivotTable every time they ran the report. However, it's not working. Please see error below and advise. I emboldened and italicized the error.
Sub LEDOTTR()
'
' LEDOTTR Macro
'
'
Range("A87").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
***ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R87C1:R8214C25", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="LED OTTR!R1C1", TableName:="PivotTable6", _
DefaultVersion:=xlPivotTableVersion14***
Sheets("LED OTTR").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("PivotTable6").PivotFields("LED")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable6").PivotFields("Hierarchy name")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable6").PivotFields("LED").CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable6").PivotFields("LED")
.PivotItems("LED Marine").Visible = False
.PivotItems("LL48 Linear LED").Visible = False
.PivotItems("Other").Visible = False
End With
ActiveSheet.PivotTables("PivotTable6").PivotFields("LED"). _
EnableMultiplePageItems = True
ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
"PivotTable6").PivotFields(" Late " & Chr(10) & "Indicator"), "Sum of Late " & Chr(10) & "Indicator", _
xlSum
ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
"PivotTable6").PivotFields("Early /Ontime" & Chr(10) & " Indicator"), _
"Sum of Early /Ontime" & Chr(10) & " Indicator", xlSum
End Sub
The answer to your problem is located here.
Your sheet name in TableDestination:="LED OTTR!R1C1" needs to be surrounded with single quotes in order for it to work TableDestination:="'LED OTTR'!R1C1"
You will also have problems with the duplicated name if you do not delete this PivotTable before rerunning the code.
In my case the trouble was related to the region settings in Windows. I downloaded a (protected) xlsm file from the internet and always got the "Run Time Error 5 - Invalid Procedure Call or Argument" error when opening it. The other answer hinted to me that it may have to do with the language settings. The scripts in the file were obviously programmed in German while my Windows was set to an English region.
In Windows 10 Settings > Time & Language > Region I changed Region as well as Regional format to German. After restarting Excel, the file worked.
I've run into this, and the error was caused by calling the Worksheet.ExportAsFixedFormat method on a hidden worksheet.
I just added the if worksheet.Visible Then condition to my code to prevent getting the Invalid Procedure Call or Argument error.
While installing macro file to excel 2016 ribbon window getting below error when I debug the error. Below section was highlighed in yellow collor when clicked on debug
Set one = Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:= _
msoControlPopup, before:=onecount)
Related
I am working on a Word macro to print a letter and its envelope to two different printers:
Sub PrintEnvelopeAndLetter()
'
' PrintEnvelopeAndLetter Macro
'
'
Dim sCurrentPrinter As String
Dim pageCount As Integer
Dim currentPosition As Range
Set currentPosition = Selection.Range 'Save the current cursor position
pageCount = ActiveDocument.ActiveWindow.Panes(1).Pages.Count
' Prompt the user to ask if they are sure they are ready to print
Result = MsgBox("Are you sure you are ready to print?" & vbCr & vbCr & "Read through your letter one last time.", _
vbYesNo + vbDefaultButton2 + vbApplicationModal + vbExclamation)
If Result = vbNo Then
Exit Sub
End If
' Display a message box asking if the user has entered the correct date
' at the top of their letter.
Result = MsgBox("Did you enter the correct date at the top of your letter?", _
vbYesNo + vbDefaultButton2 + vbApplicationModal + vbExclamation)
If Result = vbNo Then
Exit Sub
End If
' Launch the Spelling and Grammar Check
ActiveDocument.CheckSpelling
ActiveDocument.CheckGrammar
' Save the document to the disk and do not prompt the user
' to save it if the user has made changes
If ActiveDocument.Saved = False Then
ActiveDocument.Save True
End If
' Get the total number of pages in the document. NOTE: The
' envelope counts as a page
sCurrentPrinter = ActivePrinter 'Save the current printer
ActivePrinter = "HP ENVY Photo 7800 series"
Selection.HomeKey Unit:=wdStory ' move to the top of the document (envelope)
Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActivePrinter = "HP OfficeJet Pro 8030 series"
For J = pageCount To 2 Step -1
Selection.GoTo wdGoToPage, wdGoToAbsolute, J
Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
Next
ActivePrinter = sCurrentPrinter 'Restore the original printer
' Scroll the insertion point to the very beginning of the document
Selection.HomeKey Unit:=wdStory
' Save the document to the disk and do not prompt the user
' to save it if the user has made changes
If ActiveDocument.Saved = False Then
ActiveDocument.Save NoPrompt:=True
End If
End Sub
I think that my code is correct, but I was hoping if I could get a second pair of eyes. It seems to be indicating that the invalid line is:
ActiveDocument.Save NoPrompt:=True
But I think that it is correct -- see the following link:
https://learn.microsoft.com/en-us/office/vba/api/word.document.save
Consulted the link:
https://learn.microsoft.com/en-us/office/vba/api/word.document.save
I checked my own VBA code and it seems as if I am specifying the NoPrompt property correctly.
I am using Microsoft® Word for Microsoft 365 MSO (Version 2210 Build 16.0.15726.20188) 64-bit on Windows 10. I did not change my code (at least, I do not think so). The macro worked perfectly the day before yesterday.
I have also checked my printers, and both of the printers listed in the macro are installed:
Figure 1. A screenshot of my installed Printers and Scanners.
I am not entirely sure what else to check.
FIRST UPDATE
I commented out both occurrences of the code
' Save the document to the disk and do not prompt the user
' to save it if the user has made changes
If ActiveDocument.Saved = False Then
ActiveDocument.Save NoPrompt:=True
End If
in the macro, and the macro works, so I know for certain that this is the code that it is complaining about. It would seem that the compiler is complaining about a syntax error somewhere, or a function parameter that is not valid. However, every source I've consulted seems to point to this as being valid code, so I am stumped.
I'd really appreciate it if someone could help me out.
Am I doing something wrong?
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", _
I am trying to use Excel-VBA to set the PageSetup information for my worksheet, but it is giving me the following error:
Run-time error ‘1004’:
Unable to set the LeftFooter property of the PageSetup class
The relevant example code follows:
Set WS = ActiveWorkbook.ActiveSheet
WS.DisplayPageBreaks = False
With WS.PageSetup
.PrintArea = "$A$1:$L$32"
.Orientation = xlLandscape
.CenterHeader = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" & Chr(10) & _
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
.CenterFooter = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" & Chr(10) & _
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
.RightFooter = "XXXXXXXXXXXXXXXXXXXXXXX" & Chr(10) & _
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
.LeftFooter = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" & Chr(10) & _
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" & Chr(10) & _
"XXXXXXXXXXXXXXXXXXXXXXXXXX"
.CenterHorizontally = True
.Zoom = False
End With
Strangely, if I comment out any one of the three .xxxFooter lines, the code works fine. If I rearrange them into any possible different order, they all work with the exception of the last one which will throw the same 1004 error but for the new .xxxFooter.
This user seems to have a highly related problem, but did not ever resolve it: Error when setting Worksheet.PageSetup.XxxFooter. As a comment to the questions there, yes, I do have a printer installed.
Edit:
Another discovery: if I remove some of the characters, then it will work again. Adding in additional characters manually eventually caused this error box to pop up:
The text string you entered is too long. Reduce the number of characters used.
I can temporarily work around by abbreviating a lot of things in the footer, but is there any other way to solve this problem, and can anyone explain why there is a character limit in the footers? That seems arcane in Excel 2016...
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
In my document I have the Format Page Numbers / Start at: set to 0 so that the title page is not counted.
When I do a SaveAs via VBA the document loses that setting! It was also losing the Different First Page setting so I set that directly in VBA which fixed that problem. I think that because I am formatting the footer via VBA before I do the SaveAs I am somehow affecting the settings? Anyway, I tried setting the Start At page number after the SaveAs but it doesnt set it.
' Save our new Workbook - the output file
' That makes the new file the ActiveDocument
ActiveDocument.SaveAs filename:=fname & ".docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
' Sets this option correctly
ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
' Problem: Doesnt set this option
ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.StartingNumber = 0
' Update the TOC
ActiveDocument.TablesOfContents(1).Update
Any ideas?
Thanks,
Murray
"The RestartNumberingAtSection property, if set to False, will override the StartingNumber property so that page numbering can continue from the previous section." (http://msdn.microsoft.com/en-us/library/office/ff821408.aspx)
Therefore, you have to set the RestartNumberingAtSection property to true:
With ActiveDocument.Sections(1)
.Footers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = True
.Footers(wdHeaderFooterPrimary).PageNumbers.StartingNumber = 0
End With
Regards,
Leo