RE: Running Excel Addin from VBA in Access....HELP!!

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

Okay. Got an EMail address? (It's a bit long, and probably not of interest
to everybody here...)

"Tirelle" wrote:

Thanks larry. That does interest me. Would love to see code and try it.

"LarryP" wrote:

I have various databases that do various parts of this, sort of, so will
offer a couple thoughts in case they might help. Using your numbering scheme:

(1) This I've done; a routine runs a query several times, but changes the
criteria and the output name each time. The first pass therefore creates
(via acTransferSpread***) the desired Excel file with the first work***,
and each subsequent pass adds another work***.

(2), (3) and (4) When I ran into this situation, what I wound up doing was
first creating an Excel macro that did exactly what I wanted. Then I put the
entire VBA for that macro into a text file. My Access procedure opens the
target Excel file (presumably the one you just created in (1) above), inserts
the text file into that Excel workbook as a macro, then just tells Excel to
run the macro. Crunch, munch, crunch, munch, Excel does its thing, following
the instructions in your macro. Then control goes back to Access, which
closes the Excel file and ends the procedure. I found this way easier than
trying to write Excel VBA within Access, with all the objects and what have
you that are required to make that work.

If either of those is of interest, reply here and I'll get my code to you
somehow.


"Tirelle" wrote:

Please Help!!! Here are the details of my dilemna...
1.I need Access to create a new Excel Workbook with a specified number of
work*** with names.
2. I then need to run an Excel Addin from code in Access on the Active
Workbook. The Addin creates and addtional work*** in active workbook named
"measuring data" and populates it in a realtime import from a piece of test
equipment.
3. I then need to rename the new work*** to correspond to test equipment ID.
4.I need to run the Addin multiple times based on amount of test
equipment(1-3 times). I can code that functionality.

What I need help with is running th Addin in Active Workbook. I seem to be
able to partially get it to work in a new workbook. All my code is below....
It is a little choppy and I will clean it up when I get it to work. All
suggestion and help is greatly appreciated. Thank You In Advance.

Tirelle

Public Function AutomateExcel(ChargeEntry As Boolean, strBookName As String,
intNumSheets As Integer) As Workbook
'This function create a workbook for importing digital hydrometer data. A
seperate workshheet for each hydrometer
'is created. Data is imported for each hydrometer.
Dim intOrigNumSheets As Integer
Dim SheetCtr As Integer
Dim HydrometerCount As Integer
Dim strImportingFrom As String
Dim xlsHydrometerImport As Excel.Workbook
Dim xlsHydrometer*** As Excel.Work***
Dim xlApp As Excel.Application
Dim ImportFromHydrometers As VbMsgBoxResult
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range

Const TimePerHydrometerImport As Integer = 2000
Const TimePerLog*** = 2000

On Error GoTo CreateNew_Err

intOrigNumSheets = Excel.Application.SheetsInNewWorkbook
If ChargeEntry Then strBookName = "Charge_" & strBookName &
"_SpecificGravities"

Set xlApp = New Excel.Application
xlApp.SheetsInNewWorkbook = intNumSheets
xlApp.Visible = True

Set xlsHydrometerImport = Workbooks.Add
AddIns("AP-SoftPrint").Installed = True

With xlsHydrometerImport

For Each xlsHydrometerSheet In .Worksheets
xlsHydrometer***.Name = "Hydrometer No. " &
Right(xlsHydrometer***.Name, 1)
ShowProgress 500, "Creating Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1), "Creating Import Sheets. . . . . ."
xlsHydrometer***.Range("A2", "I2").Font.Bold = True
xlsHydrometer***.Range("A2", "I2").MergeCells = True
xlsHydrometer***.Range("A2", "I2").Value = "Digital Hydrometer
Imports"

xlsHydrometer***.Range("A4", "C4").Font.Bold = True
xlsHydrometer***.Range("A4", "C4").MergeCells = True
xlsHydrometer***.Range("A4", "C4").Value = "Import Date and
Time:"

xlsHydrometer***.Range("A6", "B6").Font.Bold = True
xlsHydrometer***.Range("A6", "B6").MergeCells = True
xlsHydrometer***.Range("A6", "B6").Value = "Imported:"

xlsHydrometer***.Range("E6", "F6").Font.Bold = True
xlsHydrometer***.Range("E6", "F6").MergeCells = True
xlsHydrometer***.Range("E6", "F6").Value = "Formatted:"

xlsHydrometer***.Range("D4", "E4").Font.Bold = True
xlsHydrometer***.Range("D4", "E4").MergeCells = True

xlsHydrometer***.Range("E7").Font.Bold = True
xlsHydrometer***.Range("E7").Value = "Cell"
xlsHydrometer***.Range("F7").Font.Bold = True
xlsHydrometer***.Range("F7").Value = "S.G."
xlsHydrometer***.Range("A7").Font.Bold = True
xlsHydrometer***.Range("A7").Value = "Sample"
xlsHydrometer***.Range("B7").Font.Bold = True
xlsHydrometer***.Range("B7").Value = "S.G."
DoCmd.Close acForm, "frmProgressbar", acSaveNo
Next xlsHydrometer***

.SaveAs DLookup("HydrometerLocation", "qryImportFunctions") & "\" &
strBookName
strBookName = xlsHydrometerImport.FullName
End With
For HydrometerCount = 1 To intNumSheets


'Code to simulate an import
ImportFromHydrometers = MsgBox("1. Connect Digital Hydrometer No. " &
HydrometerCount & " " & vbCrLf & "2. Ensure Hydrometer Is Turned ON. " &
vbCrLf & _
"3. Press OK. ", vbOKCancel, "Import From Hydrometers")
If ImportFromHydrometers = vbOK Then


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim str As String
str = "\AP-SoftPrint.xla"
xlApp.Workbooks.Open (xlApp.Application.LibraryPath & str)

xlApp.Application.OnTime Now(),
("AP-SoftPrint.xla!startcollection"), Now() + 1
Excel.SendKeys "{~}", True
xlApp.Application.OnTime Now(), ("AP-SoftPrint.xla!endcollection"),
Now() + 1
'Excel.CommandBars.ActionControl.OnAction
'
'
Excel.SendKeys "{~}", True

'Set xlsHydrometerSheet = Worksheets.Add
' With xlsHydrometer***
' .Name = "measuring data " & HydrometerCount
' strImportingFrom = .Name
'End With
End If

'FormatHydrometerImport strBookName, Str(HydrometerCount),
strImportingFrom
Next HydrometerCount

xlsHydrometerImport.Close SaveChanges:=True
Set xlsHydrometerImport = Nothing
Excel.Application.SheetsInNewWorkbook = intOrigNumSheets
Set xlApp = Nothing
Set AutomateExcel = Nothing
Excel.Application.Quit
CreateNew_End:
Exit Function
CreateNew_Err:
Debug.Print Err.Number & " " & Err.Description
Set AutomateExcel = Nothing
xlsHydrometerImport.Close False
Resume CreateNew_End
End Function
.

Quantcast