First of all...Happy New Year to All !!!!! I posted this in ac Access group
as well and it was suggested that you are much moer knowledgeable on th Excel
Object... So Here we go...

Here are the details of my dilemna...
1.I need Access to create a new Excel Workbook with a specified number of
worksheet with names.
2. I then need to run an Excel Addin from code in Access on the Active
Workbook. The Addin creates and addtional worksheet 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 worksheet 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 xlsHydrometerSheet As Excel.Worksheet
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 TimePerLogSheet = 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
xlsHydrometerSheet.Name = "Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1)
ShowProgress 500, "Creating Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1), "Creating Import Sheets. . . . . ."
xlsHydrometerSheet.Range("A2", "I2").Font.Bold = True
xlsHydrometerSheet.Range("A2", "I2").MergeCells = True
xlsHydrometerSheet.Range("A2", "I2").Value = "Digital Hydrometer
Imports"

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

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

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

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

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

.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 xlsHydrometerSheet
' .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

Tirelle,
I tried to clean it up and it may even run (and it may not).
There is lots more that could be done, but I lost interest...
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)

'--
Public Function AutomateExcel(ChargeEntry As Boolean, strBookName As String, _
intNumSheets As Integer) As Boolean
'This function create a workbook for importing digital hydrometer data.
'A separate workshheet for each hydrometeris created. Data is imported for each hydrometer.
Dim SheetCtr As Integer
Dim HydrometerCount As Integer
Dim strImportingFrom As String
Dim xlsHydrometerImport As Excel.Workbook
Dim xlsHydrometerSheet As Excel.Worksheet
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 TimePerLogSheet = 2000

On Error GoTo CreateNew_Err
If ChargeEntry Then strBookName = "Charge_" & strBookName & "_SpecificGravities"

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

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

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

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

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

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

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

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

' .SaveAs DLookup("HydrometerLocation", "qryImportFunctions") & "\" & strBookName 'ACCESS ?
strBookName = xlsHydrometerImport.FullName
End With

For HydrometerCount = 1 To intNumSheets
'Code to simulate an import
ImportFromHydrometers = VBA.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 strSuffix As String 'str is already used by Excel
strSuffix = "\AP-SoftPrint.xla"
' xlApp.Workbooks.Open (xlApp.LibraryPath & strSuffix) '<<< Installing it opens it!
xlApp.OnTime Now(), ("AP-SoftPrint.xla!startcollection"), Now() + 1
xlApp.SendKeys "{~}", True
xlApp.OnTime Now(), ("AP-SoftPrint.xla!endcollection"), Now() + 1
' Excel.CommandBars.ActionControl.OnAction
xlApp.SendKeys "{~}", True

'Set xlsHydrometerSheet = Worksheets.Add
' With xlsHydrometerSheet
' .Name = "measuring data " & HydrometerCount
' strImportingFrom = .Name
'End With
End If
'FormatHydrometerImport strBookName, str(HydrometerCount),strImportingFrom
Next HydrometerCount

xlsHydrometerImport.Close SaveChanges:=True
Set xlsHydrometerSheet = Nothing
Set xlsHydrometerImport = Nothing
xlApp.Quit
Set xlApp = Nothing
CreateNew_End:
Exit Function
CreateNew_Err:
Debug.Print Err.Number & " " & Err.Description
xlsHydrometerImport.Close False
Resume CreateNew_End
End Function
'---------------------


"Tirelle"
wrote in message
First of all...Happy New Year to All !!!!! I posted this in ac Access group
as well and it was suggested that you are much moer knowledgeable on th Excel
Object... So Here we go...

Here are the details of my dilemna...
1.I need Access to create a new Excel Workbook with a specified number of
worksheet with names.
2. I then need to run an Excel Addin from code in Access on the Active
Workbook. The Addin creates and addtional worksheet 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 worksheet 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
-snip-

You can use pieces of the following code to fill in the gaps in your code.
Be sure to change the values in the lines marked with '<<<

Sub AAA()

Dim XLApp As Excel.Application
Dim AI As Excel.AddIn
Dim FileName As String
Dim AddInName As String
Dim WeStartedExcel As Boolean
Dim ProcedureName As String
Dim TimesToRunProcedure As Long
Dim N As Long
Dim NewWorksheetName As String


On Error Resume Next
Set XLApp = GetObject(, "Excel.Application") ' note leading comma
If XLApp Is Nothing Then
Err.Clear
Set XLApp = CreateObject("Excel.Application") ' no leading comma
If XLApp Is Nothing Then
MsgBox "Cannot access/create Excel Applicaton"
Exit Sub
Else
WeStartedExcel = True
End If
Else
WeStartedExcel = False
End If

FileName = "C:\Book1.xls" '<<< CHANGE file name as required
AddInName = "The Add In Name" '<<< CHANGE add in name as required
ProcedureName = "Macro_Name" '<<< CHANGE procedure name as required
TimesToRunProcedure = 3 '<<< CHANGE to appropriate number of times to run
procedure
NewWorksheetName = "The New Sheet" '<<< CHANGE to the name for the new sheet

With XLApp
.Workbooks.Open FileName:=FileName
Set AI = .AddIns(AddInName)
If AI Is Nothing Then
MsgBox "Cannot find add in: " & AddInName
.ActiveWorkbook.Close savechanges:=False
If WeStartedExcel = True Then
If WeStartedExcel = True Then
.Quit
End If
End If
Exit Sub
End If
AI.Installed = True
For N = 1 To TimesToRunProcedure
.Run "'" & AI.Name & "'!" & ProcedureName
Next N
With .ActiveWorkbook.Worksheets
.Item(.Count).Name = NewWorksheetName
End With
.ActiveWorkbook.Close savechanges:=True
If WeStartedExcel = True Then
.Quit
End If
End With

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)



"Tirelle" wrote in message
...
First of all...Happy New Year to All !!!!! I posted this in ac Access
group
as well and it was suggested that you are much moer knowledgeable on th
Excel
Object... So Here we go...

Here are the details of my dilemna...
1.I need Access to create a new Excel Workbook with a specified number of
worksheet with names.
2. I then need to run an Excel Addin from code in Access on the Active
Workbook. The Addin creates and addtional worksheet 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 worksheet 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 xlsHydrometerSheet As Excel.Worksheet
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 TimePerLogSheet = 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
xlsHydrometerSheet.Name = "Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1)
ShowProgress 500, "Creating Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1), "Creating Import Sheets. . . . . ."
xlsHydrometerSheet.Range("A2", "I2").Font.Bold = True
xlsHydrometerSheet.Range("A2", "I2").MergeCells = True
xlsHydrometerSheet.Range("A2", "I2").Value = "Digital
Hydrometer
Imports"

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

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

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

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

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

.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 xlsHydrometerSheet
' .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

Thanks Chip...
But I think There is one problem I see but I haven't tried yet. There is no
macro with the AddIn. Atleast not one I can see. When I looked and the
object in object browser I can see the procedures and variables. In Excel
itself, there are no macros either. When I distribute my application, user's
will already have AddIn installed but No macros. Is this going to be a
problem?

"Chip Pearson" wrote:

You can use pieces of the following code to fill in the gaps in your code.
Be sure to change the values in the lines marked with '<<<

Sub AAA()

Dim XLApp As Excel.Application
Dim AI As Excel.AddIn
Dim FileName As String
Dim AddInName As String
Dim WeStartedExcel As Boolean
Dim ProcedureName As String
Dim TimesToRunProcedure As Long
Dim N As Long
Dim NewWorksheetName As String


On Error Resume Next
Set XLApp = GetObject(, "Excel.Application") ' note leading comma
If XLApp Is Nothing Then
Err.Clear
Set XLApp = CreateObject("Excel.Application") ' no leading comma
If XLApp Is Nothing Then
MsgBox "Cannot access/create Excel Applicaton"
Exit Sub
Else
WeStartedExcel = True
End If
Else
WeStartedExcel = False
End If

FileName = "C:\Book1.xls" '<<< CHANGE file name as required
AddInName = "The Add In Name" '<<< CHANGE add in name as required
ProcedureName = "Macro_Name" '<<< CHANGE procedure name as required
TimesToRunProcedure = 3 '<<< CHANGE to appropriate number of times to run
procedure
NewWorksheetName = "The New Sheet" '<<< CHANGE to the name for the new sheet

With XLApp
.Workbooks.Open FileName:=FileName
Set AI = .AddIns(AddInName)
If AI Is Nothing Then
MsgBox "Cannot find add in: " & AddInName
.ActiveWorkbook.Close savechanges:=False
If WeStartedExcel = True Then
If WeStartedExcel = True Then
.Quit
End If
End If
Exit Sub
End If
AI.Installed = True
For N = 1 To TimesToRunProcedure
.Run "'" & AI.Name & "'!" & ProcedureName
Next N
With .ActiveWorkbook.Worksheets
.Item(.Count).Name = NewWorksheetName
End With
.ActiveWorkbook.Close savechanges:=True
If WeStartedExcel = True Then
.Quit
End If
End With

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)



"Tirelle" wrote in message
...
First of all...Happy New Year to All !!!!! I posted this in ac Access
group
as well and it was suggested that you are much moer knowledgeable on th
Excel
Object... So Here we go...

Here are the details of my dilemna...
1.I need Access to create a new Excel Workbook with a specified number of
worksheet with names.
2. I then need to run an Excel Addin from code in Access on the Active
Workbook. The Addin creates and addtional worksheet 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 worksheet 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 xlsHydrometerSheet As Excel.Worksheet
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 TimePerLogSheet = 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
xlsHydrometerSheet.Name = "Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1)
ShowProgress 500, "Creating Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1), "Creating Import Sheets. . . . . ."
xlsHydrometerSheet.Range("A2", "I2").Font.Bold = True
xlsHydrometerSheet.Range("A2", "I2").MergeCells = True
xlsHydrometerSheet.Range("A2", "I2").Value = "Digital
Hydrometer
Imports"

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

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

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

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

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

.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 xlsHydrometerSheet
' .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

Thanks Chip... I tried it in it is working so far. i have to do a little
tweaking for my application but it will work. I really do Appreciate it.
Also... Another question. After the startcollection procedure starts..I need
to press Enter to actually start collection. How do you SendKeys the ENTER
Key?

"Chip Pearson" wrote:

You can use pieces of the following code to fill in the gaps in your code.
Be sure to change the values in the lines marked with '<<<

Sub AAA()

Dim XLApp As Excel.Application
Dim AI As Excel.AddIn
Dim FileName As String
Dim AddInName As String
Dim WeStartedExcel As Boolean
Dim ProcedureName As String
Dim TimesToRunProcedure As Long
Dim N As Long
Dim NewWorksheetName As String


On Error Resume Next
Set XLApp = GetObject(, "Excel.Application") ' note leading comma
If XLApp Is Nothing Then
Err.Clear
Set XLApp = CreateObject("Excel.Application") ' no leading comma
If XLApp Is Nothing Then
MsgBox "Cannot access/create Excel Applicaton"
Exit Sub
Else
WeStartedExcel = True
End If
Else
WeStartedExcel = False
End If

FileName = "C:\Book1.xls" '<<< CHANGE file name as required
AddInName = "The Add In Name" '<<< CHANGE add in name as required
ProcedureName = "Macro_Name" '<<< CHANGE procedure name as required
TimesToRunProcedure = 3 '<<< CHANGE to appropriate number of times to run
procedure
NewWorksheetName = "The New Sheet" '<<< CHANGE to the name for the new sheet

With XLApp
.Workbooks.Open FileName:=FileName
Set AI = .AddIns(AddInName)
If AI Is Nothing Then
MsgBox "Cannot find add in: " & AddInName
.ActiveWorkbook.Close savechanges:=False
If WeStartedExcel = True Then
If WeStartedExcel = True Then
.Quit
End If
End If
Exit Sub
End If
AI.Installed = True
For N = 1 To TimesToRunProcedure
.Run "'" & AI.Name & "'!" & ProcedureName
Next N
With .ActiveWorkbook.Worksheets
.Item(.Count).Name = NewWorksheetName
End With
.ActiveWorkbook.Close savechanges:=True
If WeStartedExcel = True Then
.Quit
End If
End With

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)



"Tirelle" wrote in message
...
First of all...Happy New Year to All !!!!! I posted this in ac Access
group
as well and it was suggested that you are much moer knowledgeable on th
Excel
Object... So Here we go...

Here are the details of my dilemna...
1.I need Access to create a new Excel Workbook with a specified number of
worksheet with names.
2. I then need to run an Excel Addin from code in Access on the Active
Workbook. The Addin creates and addtional worksheet 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 worksheet 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 xlsHydrometerSheet As Excel.Worksheet
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 TimePerLogSheet = 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
xlsHydrometerSheet.Name = "Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1)
ShowProgress 500, "Creating Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1), "Creating Import Sheets. . . . . ."
xlsHydrometerSheet.Range("A2", "I2").Font.Bold = True
xlsHydrometerSheet.Range("A2", "I2").MergeCells = True
xlsHydrometerSheet.Range("A2", "I2").Value = "Digital
Hydrometer
Imports"

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

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

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

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

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

.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 xlsHydrometerSheet
' .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

Look at Sendkeys in the VBA help, it is all given there.

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



"Tirelle" wrote in message
...
Thanks Chip... I tried it in it is working so far. i have to do a little
tweaking for my application but it will work. I really do Appreciate it.
Also... Another question. After the startcollection procedure starts..I
need
to press Enter to actually start collection. How do you SendKeys the ENTER
Key?

"Chip Pearson" wrote:

You can use pieces of the following code to fill in the gaps in your
code.
Be sure to change the values in the lines marked with '<<<

Sub AAA()

Dim XLApp As Excel.Application
Dim AI As Excel.AddIn
Dim FileName As String
Dim AddInName As String
Dim WeStartedExcel As Boolean
Dim ProcedureName As String
Dim TimesToRunProcedure As Long
Dim N As Long
Dim NewWorksheetName As String


On Error Resume Next
Set XLApp = GetObject(, "Excel.Application") ' note leading comma
If XLApp Is Nothing Then
Err.Clear
Set XLApp = CreateObject("Excel.Application") ' no leading comma
If XLApp Is Nothing Then
MsgBox "Cannot access/create Excel Applicaton"
Exit Sub
Else
WeStartedExcel = True
End If
Else
WeStartedExcel = False
End If

FileName = "C:\Book1.xls" '<<< CHANGE file name as required
AddInName = "The Add In Name" '<<< CHANGE add in name as required
ProcedureName = "Macro_Name" '<<< CHANGE procedure name as required
TimesToRunProcedure = 3 '<<< CHANGE to appropriate number of times to run
procedure
NewWorksheetName = "The New Sheet" '<<< CHANGE to the name for the new
sheet

With XLApp
.Workbooks.Open FileName:=FileName
Set AI = .AddIns(AddInName)
If AI Is Nothing Then
MsgBox "Cannot find add in: " & AddInName
.ActiveWorkbook.Close savechanges:=False
If WeStartedExcel = True Then
If WeStartedExcel = True Then
.Quit
End If
End If
Exit Sub
End If
AI.Installed = True
For N = 1 To TimesToRunProcedure
.Run "'" & AI.Name & "'!" & ProcedureName
Next N
With .ActiveWorkbook.Worksheets
.Item(.Count).Name = NewWorksheetName
End With
.ActiveWorkbook.Close savechanges:=True
If WeStartedExcel = True Then
.Quit
End If
End With

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)



"Tirelle" wrote in message
...
First of all...Happy New Year to All !!!!! I posted this in ac Access
group
as well and it was suggested that you are much moer knowledgeable on th
Excel
Object... So Here we go...

Here are the details of my dilemna...
1.I need Access to create a new Excel Workbook with a specified number
of
worksheet with names.
2. I then need to run an Excel Addin from code in Access on the Active
Workbook. The Addin creates and addtional worksheet 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 worksheet 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 xlsHydrometerSheet As Excel.Worksheet
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 TimePerLogSheet = 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
xlsHydrometerSheet.Name = "Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1)
ShowProgress 500, "Creating Hydrometer No. " &
Right(xlsHydrometerSheet.Name, 1), "Creating Import Sheets. . . . . ."
xlsHydrometerSheet.Range("A2", "I2").Font.Bold = True
xlsHydrometerSheet.Range("A2", "I2").MergeCells = True
xlsHydrometerSheet.Range("A2", "I2").Value = "Digital
Hydrometer
Imports"

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

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

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

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

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

.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 xlsHydrometerSheet
' .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