Can't get trusted access to vb project

[bobmac-]

Hi,

I'm in MS ACCESS vba creating an instance of EXCEL.
i.e automation

The new EXCEL Workbook I create needs to have Macro to do some formating.

The code:
xlApp.VBE.activeVBproject.vbcomponents.Import xxx

This should do it but I need to allow "Trusted Access to Visual Basic Project" to be turned on. (Tools-Macro-Security-Trusted Publishers). It is currently greyed out.

Is there a way to get around this greyed out check box or is there another way to load a macro into a new workbook from MS Access vba

Cheers
Bob

 

[vbaInet]

How are you creating the Access instance? Let's see the code.

From which Excel instance are you trying to set the trusted settings?

 

[bobmac-]

Hi,

Here's the sub

The macro import is the 6th last line, commented out.

I've scanned the net and I'm getting the impression it may be impossible or only possible by making Register changes. It may be that being able to code a security change into a new workbook is considered a nono.

Please, don't spend any serious time on as the output isn't frequently used and we can simply import a macro to do the formating.

In advance, many thanks

Private Sub ouputReport()
Dim IntCount As Integer
'Excel declaration
Dim xlApp As New Excel.Application
Dim xlSheet As New Excel.Worksheet
Dim xlWorkbook As New Excel.Workbook
Dim intWidth As Integer
Dim intNumbChannels As Integer
Dim intNumbMnths As Integer
Dim intMonthStart As Integer
Dim intMonthEnd As Integer
Dim intMonthsDone As Integer
Dim intNumbRootCauses As Integer
Dim intChCnt As Integer
Dim intMonthCnt As Integer
Dim intAllCnt As Integer
Dim intRootCnt As Integer
Dim strMonth As String
Dim rngMerge As Range

Set xlApp = CreateObject("Excel.Application")
Set xlWorkbook = xlApp.Workbooks.Add
Set xlSheet = xlWorkbook.Sheets(1)

xlApp.Visible = True

xlSheet.Cells(1, 2).Value = " Successful Delivery Index.... " & Now()

intNumbRootCauses = UBound(strRootHeadings)

'Root cause index row headings
outputRootDetails xlSheet, intNumbRootCauses

Select Case frmReportType.Value

Case 1 'System and Channels
intNumbChannels = UBound(strChHeadings())
Select Case frmDateRange.Value
Case 1 'Season to date
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Season to Date - System & Channels"
xlSheet.Cells(4, 1).Value = "Season:"
xlSheet.Cells(4, 2).Value = IIf(Month(Now()) > 5, Year(Now()) & "/" & Year(Now()) + 1, Year(Now()) - 1 & "/" & Year(Now()))
xlSheet.Cells(6, 2).Value = "Root Cause Index"
xlSheet.Cells(6, 4).Value = "System"

Case 2 'Date range
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Date Range - System & Channels"
xlSheet.Cells(4, 1).Value = "Start Date:"
xlSheet.Cells(4, 2).Value = "'" & Me!txtStartDate & "'"
xlSheet.Cells(5, 1).Value = "End Date:"
xlSheet.Cells(5, 2).Value = "'" & Me!txtEndDate & "'"
End Select
'Channel headings
outputChHeadings xlSheet, intNumbChannels

'General and Root data
outputGeneralCHData xlSheet, intNumbChannels, intNumbRootCauses

Case 2 'System by Month
intNumbMnths = UBound(intMnthRoot(), 1)
intMonthStart = Month(strDayMonthSeasonStart)
intMonthEnd = Month(strDayMonthSeasonEnd)

Select Case frmDateRange.Value
Case 1 'Season to date
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Season to Date - Monthly by System"
xlSheet.Cells(4, 1).Value = "Season:"
xlSheet.Cells(4, 2).Value = IIf(Month(Now()) > 5, Year(Now()) & "/" & Year(Now()) + 1, Year(Now()) - 1 & "/" & Year(Now()))
Case 2 'Date range
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Date Range - Monthly by System"
xlSheet.Cells(4, 1).Value = "Start Date:"
xlSheet.Cells(4, 2).Value = "'" & Me!txtStartDate & "'"
xlSheet.Cells(5, 1).Value = "End Date:"
xlSheet.Cells(5, 2).Value = "'" & Me!txtEndDate & "'"

End Select
'Month headings
outputMnthHeadings xlSheet, intMonthStart, intMonthEnd

'General and Root data
outputGeneralMnthData xlSheet, intNumbMnths, intNumbRootCauses

Case 3 'SubSystem by Month
intNumbMnths = UBound(intMnthRoot(), 1)
intMonthStart = Month(strDayMonthSeasonStart)
intMonthEnd = Month(strDayMonthSeasonEnd)
Select Case frmDateRange.Value
Case 1 'Season to date
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Season to Date - SubSystem by Month"
xlSheet.Cells(4, 1).Value = "SubSystem:"
xlSheet.Cells(4, 2).Value = Me!cboFilter
xlSheet.Cells(5, 1).Value = "Season:"
xlSheet.Cells(5, 2).Value = IIf(Month(Now()) > 5, Year(Now()) & "/" & Year(Now()) + 1, Year(Now()) - 1 & "/" & Year(Now()))
Case 2 'Date range
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Date Range - SubSystem by Month"
xlSheet.Cells(4, 1).Value = "SubSystem:"
xlSheet.Cells(4, 2).Value = Me!cboFilter
xlSheet.Cells(5, 1).Value = "Start Date:"
xlSheet.Cells(5, 2).Value = "'" & Me!txtStartDate & "'"
xlSheet.Cells(6, 1).Value = "End Date:"
xlSheet.Cells(6, 2).Value = "'" & Me!txtEndDate & "'"
End Select
'Month headings
outputMnthHeadings xlSheet, intMonthStart, intMonthEnd

'General and Root data
outputGeneralMnthData xlSheet, intNumbMnths, intNumbRootCauses
Case 4 'Channel by Month
intNumbMnths = UBound(intMnthRoot(), 1)
intMonthStart = Month(strDayMonthSeasonStart)
intMonthEnd = Month(strDayMonthSeasonEnd)
Select Case frmDateRange.Value
Case 1 'Season to date
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Season to Date - Channel by Month"
xlSheet.Cells(4, 1).Value = "Channel:"
xlSheet.Cells(4, 2).Value = Me!cboFilter
xlSheet.Cells(5, 1).Value = "Season:"
xlSheet.Cells(5, 2).Value = IIf(Month(Now()) > 5, Year(Now()) & "/" & Year(Now()) + 1, Year(Now()) - 1 & "/" & Year(Now()))
Case 2 'Date range
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Date Range - Channel by Month"
xlSheet.Cells(4, 1).Value = "Channel:"
xlSheet.Cells(4, 2).Value = Me!cboFilter
xlSheet.Cells(5, 1).Value = "Start Date:"
xlSheet.Cells(5, 2).Value = "'" & Me!txtStartDate & "'"
xlSheet.Cells(6, 1).Value = "End Date:"
xlSheet.Cells(6, 2).Value = "'" & Me!txtEndDate & "'"
End Select
'Month headings
outputMnthHeadings xlSheet, intMonthStart, intMonthEnd

'General and Root data
outputGeneralMnthData xlSheet, intNumbMnths, intNumbRootCauses
Case 5 'Outlet by Month
intNumbMnths = UBound(intMnthRoot(), 1)
intMonthStart = Month(strDayMonthSeasonStart)
intMonthEnd = Month(strDayMonthSeasonEnd)
Select Case frmDateRange.Value
Case 1 'Season to date
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Season to Date - Outlet by Month"
xlSheet.Cells(4, 1).Value = "Outlet:"
xlSheet.Cells(4, 2).Value = Me!cboFilter
xlSheet.Cells(5, 1).Value = "Season:"
xlSheet.Cells(5, 2).Value = IIf(Month(Now()) > 5, Year(Now()) & "/" & Year(Now()) + 1, Year(Now()) - 1 & "/" & Year(Now()))
Case 2 'Date range
xlSheet.Cells(3, 1).Value = "Report type:"
xlSheet.Cells(3, 2).Value = "Date Range - Outlet by Month"
xlSheet.Cells(4, 1).Value = "Outlet:"
xlSheet.Cells(4, 2).Value = Me!cboFilter
xlSheet.Cells(5, 1).Value = "Start Date:"
xlSheet.Cells(5, 2).Value = "'" & Me!txtStartDate & "'"
xlSheet.Cells(6, 1).Value = "End Date:"
xlSheet.Cells(6, 2).Value = "'" & Me!txtEndDate & "'"
End Select
'Month headings
outputMnthHeadings xlSheet, intMonthStart, intMonthEnd

'General and Root data
outputGeneralMnthData xlSheet, intNumbMnths, intNumbRootCauses

End Select

xlSheet.Cells.Columns.AutoFit
xlSheet.PageSetup.PrintGridlines = True
xlSheet.PageSetup.Orientation = xlLandscape
xlSheet.PageSetup.LeftMargin = 0.15
xlSheet.PageSetup.RightMargin = 0.15
'xlApp.VBE.activeVBproject.vbcomponents.Import strSDI_Formater
xlApp.Visible = True
xlApp.Quit
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

End Sub

 

[vbaInet]

I really wasn't after the entire code, I just wanted to see how you were creating the Excel instance. I didn't mean to say Access instance in my last post.

This is not a good way of creating an instance of an object, which in your case is Excel:

Dim xlApp As New Excel.Application
Dim xlSheet As New Excel.Worksheet
Dim xlWorkbook As New Excel.Workbook

change that to:

Dim xlApp As Object
Dim xlSheet As Object
Dim xlWorkbook As Object

Intellisense will not work in this case so in the meantime, use your old code but remove the New part. When you're done with everything, change it to the above.

Have you added the path to the Access db as a Trusted location in Excel?

 

[bobmac-]

Thanks for the reply

How do I, in Access, set the trused access to visual basic project in Excel?

Also, how does dimensioning the excel instance as Object change what I'm trying to do?

Cheers and many thanks
Bob

 

[vbaInet]

It can't be set in code. Imagine how unsecure an application would be if you could easily enable the security in code. You could try writing to the registry but I can't guarantee desired results.

That was just a side note because you are mixing late binding with early binding.

 

[bobmac-]

Thanks, much appreciated.

I consider this issue closed

As for early and late binding, I need to do some reading on it

Cheers

 

[boblarson]

I know this is "closed" but I would be doing the formatting by using code in Access and not by trying to add a module to Excel.

 

[bobmac-]

Thanks Bob,

I was trying to do the formatting in Access but couldn't get the Range object to work properly. I was fully qualifying the Set Range using the current worksheet but on some executions the Select at the end of the Range statement didn't select causing an error on the selection.interior


colourCells wkSheet, intColour, intStartRow, intStartCol, intNumberRows, intNumbChannels + 1

End Sub

Private Sub colourCells(wkSheet As Worksheet, intColour As Integer, intStartRow As Integer, intStartCol As Integer, intNumberRows As Integer, intNumbColumns As Integer)

wkSheet.Range(wkSheet.Cells(intStartRow, intStartCol), wkSheet.Cells(intStartRow + intNumberRows - 1, intStartCol + intNumbColumns - 1)).Select
With Selection.Interior
.ColorIndex = intColour
End With
End Sub

 

[boblarson]

You need the Application object too:

Private Sub colourCells([B][COLOR=red]ap As Excel.Application[/COLOR][/B], wkSheet As Excel.Worksheet, intColour As Integer, intStartRow As Integer, intStartCol As Integer, intNumberRows As Integer, intNumbColumns As Integer)
    wkSheet.Range(wkSheet.Cells(intStartRow, intStartCol), wkSheet.Cells(intStartRow + intNumberRows - 1, intStartCol + intNumbColumns - 1)).Select
    [B][COLOR=red]ap.[/COLOR][/B]Selection.Interior.Color = 255
End Sub

 

[bobmac-]

Thanks Bob

Worked like a charm, although I did change it to interior.colorIndex

Cheers