Create code in Access to control Excel 1

[Bullsandbears123]

I have the following code, that I run in a Macro in Excel. I would like to change it so I can run it from MS Access VBA, how can I change the code to do this?

Thanks

________________________________________________________
Function BuildMonthlyPage()

'set Variables for Worksheets
Dim sheet1 As String
Dim Sheet2 As String



'define worksheets variables
sheet1 = "Daily" ' Data source page comes from Access
Sheet2 = "Monthly" ' Named of monthly form page

'makes new worksheet
Worksheets.Add
Worksheets("sheet1&quot.Name = Sheet2





'Set page to Time Roman and 10pt
Worksheets(Sheet2).Range("a1:f50&quot.Font.Name = "Times New Roman"
Worksheets(Sheet2).Range("a1:f50&quot.Font.Size = 10


' Merge Title Cells and set formats
With Worksheets(Sheet2)
.Range("a1:f1&quot.Merge
.Range("a3:f3&quot.Merge
.Range("a4:f4&quot.Merge
'Set formats
.Range("a1:f1&quot.Font.Size = 14
.Range("a1:f1&quot.Font.Bold = True
.Range("a3:f3&quot.Font.Size = 14
.Range("a3:f3&quot.Font.Bold = True
.Range("a4:f4&quot.Font.Size = 14
.Range("a4:f4&quot.Font.Bold = True
End With

'Set start Borders
With Worksheets(Sheet2)
.Range("a4:f4&quot.BorderAround Weight:=xlMedium ' date

End With
'set End Borders

'Set Titles for Form
With Worksheets(Sheet2)

.Cells(1, 1).Value = "the Title"

End With


'End Setting Titles for Form


'Setting Variables to grab data
'Performance

Dim net As String

'End setting Variables to grab data

'Grab data
'Performance

net = Worksheets(sheet1).Cells(3, 1).Value

'Place Data
'Performance
Worksheets(Sheet2).Cells(8, 2).Value = net
Worksheets(Sheet2).Cells(9, 2).Value = longside
Worksheets(Sheet2).Cells(10, 2).Value = shortside


'End place data

'**********************************************************
'START OF GRAB AND PLACE ESTIMATE

'Define variables for Estimate
Dim rcnt As Integer
Dim ccnt As Integer
Dim tag As String
Dim tcnt As Integer
Dim Label As String
Dim counter As Integer
Dim refer As String
Dim Acnt As Integer
Dim percent As Double
Dim rcnth As Integer



rcnt = 1
ccnt = 1
tcnt = 1
Label = "Text77"

Do Until tag = Label Or tcnt > 99
tag = Worksheets(sheet1).Cells(rcnt, ccnt).Value

Do Until ccnt = 50 Or tag = Label
ccnt = ccnt + 1
tag = Worksheets(sheet1).Cells(rcnt, ccnt).Value
rcnt = 1

Do Until rcnt = 50 Or tag = Label
rcnt = rcnt + 1
tag = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Loop
Loop

tcnt = rcnt + rcnt

Loop

'holds place for 1st estimate
rcnth = rcnt + 1

'Changes text in data page to Number

counter = 1
Do Until counter > 7

week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Worksheets(sheet1).Cells(rcnt, ccnt).Value = week1
week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
rcnt = rcnt + 1
counter = counter + 1
Loop

rcnt = rcnth
'set place on atlas page
Acnt = 8
week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
'place data of estimate
Do While IsNumeric(week1)
'Grab and place data
week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Worksheets(Sheet2).Cells(Acnt, 5).Value = week1

'moves to next estimate
Acnt = Acnt + 1
rcnt = rcnt + 1
'Sets week1 so not to paste last none Number
week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Loop

'END OF GRAB AND PLACE ESTIMATE
'********************************************************

'GRAB AND PLACE MARKET CAP

'Set Variables to ZERO
rcnt = 0
ccnt = 0
tag = ""
tcnt = 0
Label = ""
counter = 0
refer = ""
Acnt = 0 ' sets place for row on atlas
awcnta = 0 ' set place for column on atlas
percent = 0
rcnth = 0



rcnt = 1
ccnt = 1
tcnt = 1
Label = "Size"

Do Until tag = Label Or tcnt > 99
tag = Worksheets(sheet1).Cells(rcnt, ccnt).Value

Do Until ccnt = 50 Or tag = Label
ccnt = ccnt + 1
tag = Worksheets(sheet1).Cells(rcnt, ccnt).Value
rcnt = 1

Do Until rcnt = 50 Or tag = Label
rcnt = rcnt + 1
tag = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Loop
Loop

tcnt = rcnt + rcnt

Loop

'holds place for 1st estimate
rcnth = rcnt + 1
rcnt = rcnth


'set place on monthly page
Acnt = 35
awcnt = 2

week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value

'Finds 1st item in Market Cap(size)
Do While week1 = ""
rcnt = rcnt + 1
week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Loop

'finds theplaces items until empty
Do Until week1 = ""

Select Case week1
Case Is = "Small"
refer = Worksheets(sheet1).Cells(rcnt, ccnt + 1).Value
Worksheets(Sheet2).Cells(35, 2).Value = refer
Case Is = "Mid"
refer = Worksheets(sheet1).Cells(rcnt, ccnt + 1).Value
Worksheets(Sheet2).Cells(36, 2).Value = refer
Case Is = "Large"
refer = Worksheets(sheet1).Cells(rcnt, ccnt + 1).Value
Worksheets(Sheet2).Cells(37, 2).Value = refer
End Select

rcnt = rcnt + 1
week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Loop


'Finds start of Short Sectors
Do While week1 = ""
rcnt = rcnt + 1
week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Loop

'finds the Short items until empty
Do Until week1 = ""

Select Case week1
Case Is = "Small"
refer = Worksheets(sheet1).Cells(rcnt, ccnt + 1).Value
Worksheets(Sheet2).Cells(35, 3).Value = refer
Case Is = "Mid"
refer = Worksheets(sheet1).Cells(rcnt, ccnt + 1).Value
Worksheets(Sheet2).Cells(36, 3).Value = refer
Case Is = "Large"
refer = Worksheets(sheet1).Cells(rcnt, ccnt + 1).Value
Worksheets(Sheet2).Cells(37, 3).Value = refer
End Select
rcnt = rcnt + 1
week1 = Worksheets(sheet1).Cells(rcnt, ccnt).Value
Loop




Format Page to monthly'With Cells(1, 1)
.Value = "Name of Title"
.Font.Bold = True
.Font.Size = 14
End With



Range("a1:c5&quot.Interior.ColorIndex = 36
Range("a1:c5&quot.BorderAround Weight:=xlThick



End Function

 

[rdodge]

You will need to create an Excel.Application Variable

Dim XLApp as Excel.Application.

Then in your procedure, you would use
Set xlApp = New Excel.Application

After this point, you must use the xlApp variable to prequalify your Excel application. that is cause Application refers to the application that the code is in, which in this case is Access, which doesn't have the Excel Objects.

Example:

Dim WB as Excel.Workbook

Set xlApp = New Excel.Application
Set WB = XLApp.Workbooks(1)
WB.Worksheets(1).Range("A1&quot.Value = "TestCode"

You will notice in the above code sample, we first set the excel application to a variable, which actually opens up the Excel application

We then set the WB reference to the first workbook that's in there using the XLApp variable, since it's Excel we want to manipulate, not Access.

We then put the value, "TestCode" in Cell "A1" on the first worksheet of the first workbook using the WB variable and note, we didn't prequalify this cause it already has a reference to the Workbook location, as was done by the Set Object Var to the Object it's refering to. This is the only exception to not having to prequalify Excel Objects with the Excel Application variable,when the Variable has already been set to it's location in the code.

Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000

 

[Bullsandbears123]

Thanks, but what if I needed to open an excel file with path c:\myfile

Then how would I get excel to open it so I can start changing it.

Thanks again, this is very helpful

 

[rdodge]

After you have set the application object, you can open the file with the Workbooks collection in Excel. Example:

XLApp.Workbooks.Open "C:\MyFile.xls"

There are additional arguments you can set on the Open Method of the Workbooks Collection Object.

Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000

 

[Bullsandbears123]

I tried your code but I get an error when I try to save and close. What am I doing wrong?

THanks


Function mytestingfunction()


Dim XLApp As Excel.Application
Dim WB As Excel.Workbook

Set XLApp = New Excel.Application

XLApp.Workbooks.Open "C:\MytestFile.xls"

Set WB = XLApp.Workbooks(1)
WB.Worksheets(1).Range("A1&quot.value = "TestCode"
WB.Worksheets(1).Range("A2&quot.value = "second"
XLApp.SaveWorkspace (&quot;c:\Mytestfile.xls&quot '<--error here

XLApp.Workbooks(1).Close

Set XLApp = Nothing
Set WB = Nothing

 

[JR2913]

Try changing the command to:

XLApp.SaveAs Filename:=&quot;c:\Mytestfile.xls&quot;


John R

 

[rdodge]

XLApp.SaveWorkspace (&quot;c:\Mytestfile.xls&quot

With the above line, you are including the parantheses, which is not to be done unless you are using the function to have it return a value.

On the other hand, you don't necessarily have to include the &quot;Filename:=&quot; tid bit cuase the file name is the first argument. If it was the second or later argument and you don't use the commas to tell the Method which argument it belows to, then you would have to include that tid bit. Thefore, type the following line of code:

XLApp.SaveWorkspace &quot;c:\Mytestfile.xls&quot;

Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000

 

[Bullsandbears123]

I keep running into problems.
Problems:
1) When I use XLAPP.saveworkspace &quot;c:\mytestfile.xls&quot;
the computer prompts me for a &quot;do you want to replace existing file&quot; message. I just want to save changes and close the file, so yes I would like to overwrite.

2) Excel seems to stay open in the &quot;processes&quot; What do I need to change to make sure excel and the changed file are completely closed and quit.

Many thanks, this is very helpful and I appreciate it!

 

[rdodge]

For saving the file itself, you can do one of 2 things

If not changing the file location, do

XLApp.Workbooks(&quot;mytestfile.xls&quot.Save

If you are changing the file location, do

XLApp.Workbooks(&quot;mytestfile.xls&quot.SaveCopyAs &quot;c:\mytestfile.xls&quot;

This way, you can save the file and not get the replace error message

Then to close the workbook, just do

XLAPP.Workbooks(&quot;mytestfile.xls&quot.Close

which then you can set the XLAPP to nothing to close Excel like:

Set XLAPP = Nothing

Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000

 

[Bullsandbears123]

Thank you , It works GREAT!!!

 

[mmor10]

I have been looking everywhere for the code to merge cells in Excel through Visual Basic. You're snippet of code worked perfectly. Thank you!