I need help with writing a fully qualified macro code.

[Juno123]

I need help with writing a fully qualified macro code for the following code snippet-
Sub Test()
Dim ChObj As ChartObject
Dim Top As Double
Dim Left As Double
Application.ScreenUpdating = False
For Each ChObj In ActiveSheet.ChartObjects
Top = ChObj.Top
Left = ChObj.Left
ChObj.Cut
ActiveSheet.Pictures.Paste.Select
Selection.Top = Top
Selection.Left = Left
Next ChObj
Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[Juno123]

http://support.microsoft.com/default.aspx?scid=kb;en-us;Q319832

This is the Microsoft article which indicates the error I am facing and specifies a need for fully qualified code for avoiding the issue.

This is kind of urgent. Can somebody please help me with this ?

Thanks in advance,

Juno

 

[RoryA]

That article relates to automating one app from another, which does not appear relevant here. What's the actual error?

 

[Juno123]

Thanks for the reply Rorya. Actually I forgot to mention that this code is being automated through a java application onto an excel template. Now I have decided to disable this functionality from the java application and directly use the code in the macro sheet.


Option Explicit
Option Base 1

Sub MAIN()

Dim ErrRow As Integer
Dim AgencyRep As Boolean, Guarantee As Boolean, Adjustments
Dim StartRow As Integer, EndRow As Integer, BreakRow

On Error GoTo ErrorHandler

If Range("NonBonusableCommissions").Value = False Then
Sheets("ReportSheet").Select
Range("FreightComms").Delete
End If


If Range("IsAvance").Value = False Then
Sheets("ReportSheet").Select
Range("AvanceComms").Delete
End If

If Range("IsAvance").Value = False And Range("NonBonusableCommissions").Value = False Then
Sheets("ReportSheet").Select
Range("NonBonusableEarn1").Delete
Range("NonBonusableEarn2").Delete
Range("NonBonusableComms").Delete
End If



copyFormulas_extended "Table17", "DataSheet", 1, "Table17Formulas", "DataSheet", 0
copyFormulas_extended "Table17", "DataSheet", 1, "SalesAllocationFormulas", "ReportSheet", 1



'Need to delete the extra rows on the reportsheet in the SalesAllocation section.
If Range("SalesAllocation").Cells(4, 23).Value = "" Then 'Account for Header Rows
Range("SalesAllocation").Cells(4, 2).Select
Else
Range("SalesAllocation").Cells(4, 2).Select
Selection.End(xlDown).Select
End If
StartRow = Selection.Row + 1
Selection.End(xlDown).Select
EndRow = Selection.Row - 2
Rows(StartRow & ":" & EndRow).Select
Selection.Delete
'Extra Rows in SalesAllocation section deleted

AgencyRep = Range("IsAgencyRep").Value
Guarantee = Range("IsGuaranteed").Value
Adjustments = Range("NoAdjustmentsText").Value

If Adjustments = "" Then
'Delete the NoAdjustments TextBox
ActiveSheet.Shapes("NoAdjustments").Select
Selection.Delete
End If

Call BonusADM_Formatting

If AgencyRep Then
'Delete the following sections
DeleteRange "EarningsGuarantee"
DeleteRange "EarningsNoGuarantee"
DeleteRange "CommissionEarnings"
DeleteRange "Overrides"
DeleteRange "Adjustments"
Else
'Delete one of the two earnings sections
If Guarantee Then
DeleteRange "EarningsNoGuarantee"
Else
DeleteRange "EarningsGuarantee"
End If

'Insert a Page Break for non Agency Reps at the Adjustments section
Sheets("ReportSheet").Select
BreakRow = Range("Adjustments").Row
Cells(BreakRow, 1).PageBreak = xlManual

End If

Sheets("ReportSheet").Select
ActiveWindow.DisplayHeadings = False
Cells(1, 1).Select

Call DelRows_MD

Call ScaleAttainmentGraph


'Call PasteValues

Sheets("ReportSheet").Select
Range("A1").Select
Exit Sub

ErrorHandler:
ErrRow = 15 ' default is set to the last row of the ValidationRange
' Set the Severity Level to 1 so that ReportCreation will skip the next Template
' since if there is an error then, you do not want to waste time processing remaining reports
ThisWorkbook.Activate
Range("ValidationRange").Offset(ErrRow, 1).Resize(1, 1) = "Error"
' Set the Error value to 1 so that ReportCreation knows that it is an error
Range("ValidationRange").Offset(ErrRow, 2).Resize(1, 1) = 1
' Set the Error desc to Excel's error desc
Range("ValidationRange").Offset(ErrRow, 3).Resize(1, 1) = "Macro Err: " & "Err No. - " & Err & " " & Error(Err)

End Sub

Sub Run_Before_Printing()
'Macro to be executed before printing reports from Analyzer
Return
End Sub

'for the base table we need 1)the table name, 2)the sheet name, 3)the number of headers, 4)the total number of rows used
'for the formula we need 1)the formula name range, 2)the sheet name
'need to specify if you want to paste the formats also [1 = paste format, 0 = don't paste format]
Sub copyFormulas_extended(btName, btSheetName, btNumHeaders, fName, fSheetName, copyFormats)

Dim frow%, trow%
Dim erow, fcol
Dim btLength%

frow = Sheets(fSheetName).Range(fName).Row
fcol = Sheets(fSheetName).Range(fName).Column
trow = Sheets(btSheetName).Range(btName).Row

'find the total number of rows used on the base table
Sheets(btSheetName).Select
trow = Range(btName).Row + btNumHeaders
Range(btName).Cells(btNumHeaders + 2, 1).Select
If Range(btName).Cells(btNumHeaders + 2, 1) <> "" Then
Range(btName).Cells(btNumHeaders + 1, 1).Select
Selection.End(xlDown).Select
btLength = Selection.Row - trow + 1
End If

Sheets(fSheetName).Select
If btLength > 1 Then
Range(fName).Copy
Range(Cells(frow + 1, fcol), Cells(frow + btLength - 1, fcol)).Select
If copyFormats = 1 Then
ActiveSheet.Paste
Else
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
End If

End Sub
Sub DelRows_MD()
'To Delete extra rows in the marketing division table.

Dim MD_BottomRow, MD_StartRow, MD_Count

MD_BottomRow = Worksheets("DataSheet").Range("MD_BottomRow").Value
MD_StartRow = Worksheets("DataSheet").Range("MD_StartRow").Value
MD_Count = Worksheets("DataSheet").Range("MD_Count").Value

Worksheets("ReportSheet").Select

Worksheets("ReportSheet").Rows(MD_StartRow + MD_BottomRow & ":" & _
MD_StartRow + MD_Count).Select
Selection.EntireRow.Hidden = True

End Sub

Sub DeleteRange(RangeToDelete)
Range(RangeToDelete).Select
Selection.Delete
End Sub

Function ends_with(Searched, SearchedFor)
If Len(Searched) >= Len(SearchedFor) Then
If Mid(Searched, Len(Searched) - Len(SearchedFor) + 1) = SearchedFor Then
ends_with = True
End If
End If
End Function


Sub assemblyprep()
Dim d, s
For Each s In ActiveWorkbook.Worksheets
Sheets(s.Name).Activate
ActiveSheet.Unprotect
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Next s

For Each d In ActiveWorkbook.Names
If Not ends_with(d.Name, "Print_Area") And Not ends_with(d.Name, "Print_Titles") Then
d.Delete
End If

Next
End Sub

Sub PasteValues()

Dim ObjChart, shtobj As Object

For Each shtobj In Worksheets
If InStr(UCase(shtobj.Name), "REPORT") <> 0 Then
shtobj.Activate
For Each ObjChart In ActiveSheet.ChartObjects
ObjChart.Select
'Graphs and pictures will be in Black & White
'if your default printer is a B&W printer... Change Default Printer to accomodate
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
ActiveSheet.Paste
Selection.Height = ObjChart.Height
Selection.Width = ObjChart.Width
Selection.Top = ObjChart.Top
Selection.Left = ObjChart.Left
Selection.Border.LineStyle = ObjChart.Border.LineStyle
Selection.Interior.ColorIndex = ObjChart.Interior.ColorIndex
Selection.Interior.Pattern = ObjChart.Interior.Pattern
Selection.Shadow = ObjChart.Shadow
Selection.SendToBack
ObjChart.Delete
Application.CutCopyMode = False
Next ObjChart

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
' deselect the selection on the sheet
Range("A1").Select
'EmptyClipboard
Application.CutCopyMode = False
End If
Next
Set ObjChart = Nothing
Set shtobj = Nothing

End Sub


Sub FinalReport()
Dim s
'This macro is to be run during a separate publish option
'to allow the client to update the IC Report to make them Final
'without having to rerun the entire job
Range("Final").Value = True
For Each s In ActiveWorkbook.Worksheets
Sheets(s.Name).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Cells(1, 1).Select
Next s
End Sub

Sub ScaleAttainmentGraph()

Dim AttainmentGraphMin, AttainmentGraphMax

AttainmentGraphMin = Range("AttainmentGraphMin").Value
AttainmentGraphMax = Range("AttainmentGraphMax").Value

Sheets("ReportSheet").Activate
ActiveSheet.ChartObjects("Chart 6").Activate
ActiveChart.ChartArea.Select
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = AttainmentGraphMin
.MaximumScale = AttainmentGraphMax
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlCustom
.CrossesAt = AttainmentGraphMin
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
Range("A1").Select
End Sub
Sub BonusADM_Formatting()

Dim i, adjstart, adjend

adjstart = Range("adjstartrow").Value
adjend = Range("adjendrow").Value

Sheets("ReportSheet").Select

For i = adjstart To adjend - 1

If Cells(i, 2).Value = "BonusJP" Then

Range("B" & i).Select
Selection.ClearContents

Range("B" & i).Select
ActiveCell.FormulaR1C1 = "DOUBLE COMMISSION"
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Italic = True
Selection.Font.Bold = True
With Selection.Font
.Name = "Times New Roman"
.Size = 13
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.ColorIndex = 49

Range("M" & i).Select
Selection.ClearContents

Range("AG" & i).Select
ActiveCell.FormulaR1C1 = "(Max 5%)"
Selection.Font.Italic = True
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Times New Roman"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.ColorIndex = 49

Range("AQ" & i).Select
ActiveCell.FormulaR1C1 = "JP Spring Promotion"
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Times New Roman"
.Size = 13
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Italic = True
Selection.Font.Bold = True
Selection.Font.ColorIndex = 49

Range("DF" & i).Select
Selection.ClearContents

Range("BW" & i).Select
Selection.Copy
Range("DF" & i).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Font.ColorIndex = 49
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial Narrow"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 49
End With

Range("CM" & i).Select
Selection.ClearContents

Range("BW" & i).Select
Selection.ClearContents

Rows(i & ":" & i).Select
Selection.RowHeight = 25

Range("B" & i & ":DF" & i).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 49
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 49
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 49
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 49
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone

Range("DF" & i).Select
With Selection
.HorizontalAlignment = xlRight
End With

End If
Next i

End Sub


So the above code is being used in the excel template and the code that I mentioned earlier is being called from a java application. The problem that I am facing is the random excel crashes.

Thanks,
Juno

 

[RoryA]

Crashes in what way? Error message, total shutdown, other?
Unless you can narrow it down the chances of finding the error in all that code are slim unless someone has a lot of free time today (which I don't sadly).

 

[Juno123]

Hi Rorya,

I get random errors like-
Error while pasting charts as graphics Automation error The object invoked has disconnected from its clients

Error while pasting charts as graphics Method 'Delete' of object 'ChartObjects' failed

Thanks again,
Juno

 

[CharlesChuckieCharles]

if you are trying to turn the charts into pictures....
Maybe you should be using PasteSpecial instead of just paste

 

[Juno123]

Thanks Charles, but that didnt solve the problem.

Can somebody let me know the difference between qualified and unqualified code ? If possible let me know how to identify a unqualified code and convert it to a qualified one.

 

[RoryA]

Fully qualified code has every object properly qualified to the relevant application. For example rather than:

Sheets(1).select
range("A1").value = "blah"

you need to start with an Excel.Application object as that is the top level, and qualify down from there:

Dim appXL as Excel.Application
Dim wbkXL as Excel.Workbook
Set appXL = Excel.Application
set wbkXL = appXL.ActiveWorkbook
wbkXL.Sheets(1).Range("A1").Value = "blah"

note that it is generally a bad idea to select an object then manipulate the Selection object. Instead, manipulate objects directly, as in the code above.

It is usually unnecessary when running code within Excel to fully qualify right back up to the Application object, since that is assumed to be the current instance, but it is always wise to specify the workbook and worksheet.

 

[Juno123]

Thanks Rorya.

When I am trying to run the following macro-
Sub Test()
Dim ChObj As ChartObject
Dim wsReport As Worksheet
Dim Top As Double
Dim Left As Double
Application.ScreenUpdating = False
Set wsReport = Worksheets("ReportSheet")
For Each ChObj In wsReport.ChartObjects
Top = ChObj.Top
Left = ChObj.Left
ChObj.Cut
wsReport.Pictures.Paste.Select
Selection.Top = Top
Selection.Left = Left
Next ChObj
Range("A1").Select
Application.ScreenUpdating = True
End Sub

The macro code is failing with the following error-

Unable to set the Top property of the Range class

Any thoughts on this ?