G
Guest
I want to execute mentioned excel add-in from access.
In my access code I open a new excel workbook, make mentioned add-in
installed, then I try to execute it but if fails ("cannot find macro...")
If I execute code in an excel macro it works. If I do it in a access
procedure It does not.
I need help please,
Please have a look to code in access: (focus on application.run
"ATPVBAEN.XLA..." line, the rest of the code works fine)
Object variables WB, miEXCEL, are declared and set in another part of the
application.
Function CalcularDatos(oRespuesta As String) As Boolean
Dim PFe As Excel.PivotField
Dim PIe As Excel.PivotItem
Dim PFmc As Excel.PivotField
Dim PImc As Excel.PivotItem
Dim TopRow As Long
Dim TopCol As Long
Dim rgEntrada As Range
Dim rgSalida As Range
Dim ByColRow As String
Dim RotulosCol1 As Boolean
Dim ResumenEstadisticas As Boolean
Dim KesimoMayor As Long
Dim KesimoMenor As Long
Dim NivelConfianza As Long
CalcularDatos = False
On Error GoTo Error_CalcularDatos
'Recorro los pivotitems del pivotfield "Edición"
Set PFe = PTdb.PivotFields("Edición")
Set PFmc = PTdb.PivotFields("Mini CompañÃa")
Set WSw1 = WB.Sheets.Add: WSw1.Name = "Hoja Intermedia (1)"
Set WSw2 = WB.Sheets.Add: WSw2.Name = "Hoja Intermedia (2)"
Set WSae = WB.Sheets.Add: WSae.Name = "Hoja intermedia (3)"
Set WSdat = WB.Sheets.Add: WSdat.Name = "Hoja intermedia (4)"
For Each PIe In PFe.PivotItems
PFe.CurrentPage = PIe.Name
For Each PImc In PFmc.PivotItems
PFmc.CurrentPage = PImc.Name
'Limpio hoja
WSw1.Cells.Delete: WSw2.Cells.Delete
'Copio cabeceras
PTdb.RowRange.Copy
WSw1.Cells(2, 1).PasteSpecial xlPasteValues
PTdb.ColumnRange.Copy
WSw1.Cells(1, 2).PasteSpecial xlPasteValues
WSw1.Rows(1).Delete
'Copio datos
PTdb.DataBodyRange.Copy
WSw1.Cells(2, 1).PasteSpecial xlPasteValues
Set RG = miEXCEL.Selection
TopRow = RG.Rows.Count: TopCol = RG.Columns.Count
WSw1.Activate
Set rgEntrada = WSw1.Range(WSw1.Cells(1, 1), WSw1.Cells(TopRow + 1,
TopCol + 1))
'rgEntrada.Select
'Ejecuto función EstadÃstica Descriptiva
Set rgSalida = WSae.Range("A1")
ByColRow = "C": RotulosCol1 = True: ResumenEstadisticas = True:
KesimoMenor = 1: KesimoMayor = 1: NivelConfianza = 95
miEXCEL.AddIns("Herramientas para análisis").Installed = False:
miEXCEL.AddIns("Herramientas para análisis").Installed = True
On Error Resume Next
miEXCEL.Application.Run "ATPVBAEN.XLA!Descr", rgEntrada, rgSalida,
ByColRow, RotulosCol1, ResumenEstadisticas, KesimoMayor, KesimoMenor,
NivelConfianza
Next PImc
Next PIe
Fin_OK:
CalcularDatos = True
Fin:
Exit Function
Error_CalcularDatos:
oRespuesta = "" & Chr(10) & Err.Number & " - " & Err.Description
End Function
In my access code I open a new excel workbook, make mentioned add-in
installed, then I try to execute it but if fails ("cannot find macro...")
If I execute code in an excel macro it works. If I do it in a access
procedure It does not.
I need help please,
Please have a look to code in access: (focus on application.run
"ATPVBAEN.XLA..." line, the rest of the code works fine)
Object variables WB, miEXCEL, are declared and set in another part of the
application.
Function CalcularDatos(oRespuesta As String) As Boolean
Dim PFe As Excel.PivotField
Dim PIe As Excel.PivotItem
Dim PFmc As Excel.PivotField
Dim PImc As Excel.PivotItem
Dim TopRow As Long
Dim TopCol As Long
Dim rgEntrada As Range
Dim rgSalida As Range
Dim ByColRow As String
Dim RotulosCol1 As Boolean
Dim ResumenEstadisticas As Boolean
Dim KesimoMayor As Long
Dim KesimoMenor As Long
Dim NivelConfianza As Long
CalcularDatos = False
On Error GoTo Error_CalcularDatos
'Recorro los pivotitems del pivotfield "Edición"
Set PFe = PTdb.PivotFields("Edición")
Set PFmc = PTdb.PivotFields("Mini CompañÃa")
Set WSw1 = WB.Sheets.Add: WSw1.Name = "Hoja Intermedia (1)"
Set WSw2 = WB.Sheets.Add: WSw2.Name = "Hoja Intermedia (2)"
Set WSae = WB.Sheets.Add: WSae.Name = "Hoja intermedia (3)"
Set WSdat = WB.Sheets.Add: WSdat.Name = "Hoja intermedia (4)"
For Each PIe In PFe.PivotItems
PFe.CurrentPage = PIe.Name
For Each PImc In PFmc.PivotItems
PFmc.CurrentPage = PImc.Name
'Limpio hoja
WSw1.Cells.Delete: WSw2.Cells.Delete
'Copio cabeceras
PTdb.RowRange.Copy
WSw1.Cells(2, 1).PasteSpecial xlPasteValues
PTdb.ColumnRange.Copy
WSw1.Cells(1, 2).PasteSpecial xlPasteValues
WSw1.Rows(1).Delete
'Copio datos
PTdb.DataBodyRange.Copy
WSw1.Cells(2, 1).PasteSpecial xlPasteValues
Set RG = miEXCEL.Selection
TopRow = RG.Rows.Count: TopCol = RG.Columns.Count
WSw1.Activate
Set rgEntrada = WSw1.Range(WSw1.Cells(1, 1), WSw1.Cells(TopRow + 1,
TopCol + 1))
'rgEntrada.Select
'Ejecuto función EstadÃstica Descriptiva
Set rgSalida = WSae.Range("A1")
ByColRow = "C": RotulosCol1 = True: ResumenEstadisticas = True:
KesimoMenor = 1: KesimoMayor = 1: NivelConfianza = 95
miEXCEL.AddIns("Herramientas para análisis").Installed = False:
miEXCEL.AddIns("Herramientas para análisis").Installed = True
On Error Resume Next
miEXCEL.Application.Run "ATPVBAEN.XLA!Descr", rgEntrada, rgSalida,
ByColRow, RotulosCol1, ResumenEstadisticas, KesimoMayor, KesimoMenor,
NivelConfianza
Next PImc
Next PIe
Fin_OK:
CalcularDatos = True
Fin:
Exit Function
Error_CalcularDatos:
oRespuesta = "" & Chr(10) & Err.Number & " - " & Err.Description
End Function