Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Locking Cells in Spreadsheet from Access

Status
Not open for further replies.

HaydenMB

IS-IT--Management
May 30, 2003
24
GB
Hi,

I have written some code that opend up a template spreadsheet file and then sends data to the spreadsheet for every consignment within a recordset.

I intend to send this spreadsheet/advice note out to the relevant suppliers (This has not been added to the code example below) for them to edit and return.

But here's the fun part. I need to lock certain cells so the suppliers cannot edit certain data. Can this be done from Access VBA, your help would be greatly appreciated.

Many Thanks,
Hayden



[red]
Sub ExportAdviceNotes()
Dim appXL As New Excel.Application
Dim wkbXL As New Excel.Workbook
Dim wsXL As Excel.Worksheet
Dim db As DAO.Database
Dim rstHeader As DAO.Recordset
Dim rstParts As DAO.Recordset
Dim strFile As String
Dim strCons As String
Dim strTemplate As String
Dim strDate As String
Dim strSQL As String

Set db = CurrentDb
Set rstHeader = db.OpenRecordset("Advice Note Header")
rstHeader.MoveFirst
[/red][green]
'Prompt User to select the template [/green][red]
strTemplate = PromptFileName

Do Until rstHeader.EOF

strCons = rstHeader!ConsignmentNumber
strSQL = "SELECT [Advice Note Export].IPFPartNumber, [Advice Note Export].Quantity FROM [Advice Note Export] GROUP BY [Advice Note Export].ConsignmentNumber, [Advice Note Export].IPFPartNumber, [Advice Note Export].Quantity HAVING ((([Advice Note Export].ConsignmentNumber)='" & strCons & "'));"
Set rstParts = db.OpenRecordset(strSQL)
'Debug.Print strSQL

Set wkbXL = appXL.Workbooks.Open(strTemplate)

With appXL

.Visible = False

ActiveSheet.Range("D2").Value = Trim(rstHeader!ConsignmentNumber)
ActiveSheet.Range("B4").Value = Trim(rstHeader!GSDBCode)
ActiveSheet.Range("B5").Value = Trim(rstHeader!SuppName)
ActiveSheet.Range("B6").Value = Trim(rstHeader!City)
ActiveSheet.Range("B7").Value = Trim(rstHeader!Zip)
ActiveSheet.Range("B8").Value = Trim(rstHeader!Country)
ActiveSheet.Range("B10").Value = Trim(rstHeader!Telephone1)
ActiveSheet.Range("B11").Value = Trim(rstHeader!Fax1)
ActiveSheet.Range("B12").Value = Trim(rstHeader!Email1)
ActiveSheet.Range("H5").Value = rstHeader!CollectionDate
ActiveSheet.Range("H6").Value = Format(rstHeader!DeliveryDate, "dd/mm/yy")
ActiveSheet.Range("K4").Value = Trim(rstHeader!DeliveryDock)
ActiveSheet.Range("G7").Value = Trim(rstHeader!DeliveryWeek)

ActiveSheet.Range("A16").CopyFromRecordset rstParts

strDate = Format(rstHeader!CollectionDate, "dd-mm-yyyy")
strFile = "D:\My Documents\Advice Notes\" & rstHeader!GSDBCode & "-" & strDate & "-" & rstHeader!DeliveryDock & ".xls"

ActiveSheet.SaveAs strFile

Set rstParts = Nothing

rstHeader.MoveNext

End With

Loop

MsgBox "Completed"

wkbXL.Close

Set rstHeader = Nothing
Set appXL = Nothing
Set wkbXL = Nothing
Set wsXL = Nothing

Exit Sub
[/red]

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top