I need help with locking selective cells in excel

A

Al

I am exporting a table from Access to Excel for some one who is going to make
comments in specific columns then I import the excel file back to access with
the comments. The system works OK importing and Exporting however, I am
trying to lock columns A:M and unlock N:R for the Responder to write their
comments. I am also trying to wrap text on all cells. below see the code.
***********************************************
Private Sub cmdExport_Click()
Dim strPath As String, wsData As Worksheet, strFile As String, tblName
As String, I As Integer
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim xlrng As Excel.Range

If IsNull(txtPath) Then
Me.cmdExport.Enabled = True
Me.cmdExport.SetFocus
Me.cmdGo.Enabled = False
MsgBox "Please enter valid path then click <Re-Export>"
Exit Sub
Else
tblName = Me.txtFile
strPath = Me.txtPath
strFile = Replace([txtFile], ":", "")
strFile = Replace(strFile, "/", "")
strFile = Replace(strFile, " ", "_")

DoCmd.TransferSpreadsheet acExport, 8, tblName, strPath & strFile, True

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strPath & strFile)
Set xlWs = xlWb.ActiveSheet
Set xlrng = xlWs.Range("A1:Z1")

xlApp.Visible = False
xlWs.Columns.AutoFit
'xlWs.Columns(14).Width = xlWs.Columns(12).Width

With xlWs
For I = 1 To 1
.Columns(I).Hidden = True
Next I

'Unlock AE Cells
For I = 14 To 18
.Columns(I).ColumnWidth = 17
Next I
.Columns(16).ColumnWidth = 125
.Protect UserInterfaceOnly:=True
.Cells.Locked = False


'Lock all cells that are not AE cells
For I = 1 To 13
.Columns(I).ColumnWidth = 17
Next I
.Columns(16).ColumnWidth = 125
.Protect UserInterfaceOnly:=True
.Cells.Locked = True 'lock all cells on sheet 1-13 (A:M)
End With
With xlrng
.Font.Bold = True
.Borders.LineStyle = xlContinuous
'.Borders.LineStyle = xlMedium
.BorderAround xlContinuous, xlThick, 0
.Locked = True
End With

xlWb.Close savechanges:=True
xlApp.Quit
MsgBox "Data has been exported!"
End If
End Sub
******************************************

Can some one help
thanks
 
S

Steve Sanford

Try this: (watch for line wrap)

Private Sub cmdExport_Click()
Dim strPath As String, wsData As Worksheet, strFile As String, tblName As
String, I As Integer
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Worksheet
Dim xlrng As Range

If IsNull(Me.txtPath) Then
Me.cmdExport.Enabled = True
Me.cmdExport.SetFocus
Me.cmdGo.Enabled = False
MsgBox "Please enter valid path then click <Re-Export>"
Exit Sub
End If

tblName = Me.txtFile
strPath = Me.txtPath
strFile = Replace([txtFile], ":", "")
strFile = Replace(strFile, "/", "")
strFile = Replace(strFile, " ", "_")

DoCmd.TransferSpreadsheet acExport, 8, tblName, strPath & strFile, True

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strPath & strFile)
Set xlWs = ActiveSheet
Set xlrng = Range("A1:Z1")

xlApp.Visible = False
xlWs.Columns.AutoFit
'xlWs.Columns(14).Width = xlWs.Columns(12).Width

With xlWs

'lock all cells on worksheet
.Cells.Locked = True

'set column widths
For I = 1 To 13
.Columns(I).ColumnWidth = 17
Next I

For I = 14 To 18
'set column widths
.Columns(I).ColumnWidth = 17
'Unlock Cells
.Columns(I).Cells.Locked = False
Next I
.Columns(16).ColumnWidth = 125

'hide column A
.Columns(1).Hidden = True
' For I = 1 To 1
' .Columns(I).Hidden = True
' Next I
End With

With xlrng
.Font.Bold = True
.Borders.LineStyle = xlContinuous
'.Borders.LineStyle = xlMedium
.BorderAround xlContinuous, xlThick, 0
.Locked = True
End With

'protect worksheet
xlWs.Protect UserInterfaceOnly:=True

xlWb.Close savechanges:=True
xlApp.Quit
MsgBox "Data has been exported!"

End Sub



HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


Al said:
I am exporting a table from Access to Excel for some one who is going to make
comments in specific columns then I import the excel file back to access with
the comments. The system works OK importing and Exporting however, I am
trying to lock columns A:M and unlock N:R for the Responder to write their
comments. I am also trying to wrap text on all cells. below see the code.
***********************************************
Private Sub cmdExport_Click()
Dim strPath As String, wsData As Worksheet, strFile As String, tblName
As String, I As Integer
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim xlrng As Excel.Range

If IsNull(txtPath) Then
Me.cmdExport.Enabled = True
Me.cmdExport.SetFocus
Me.cmdGo.Enabled = False
MsgBox "Please enter valid path then click <Re-Export>"
Exit Sub
Else
tblName = Me.txtFile
strPath = Me.txtPath
strFile = Replace([txtFile], ":", "")
strFile = Replace(strFile, "/", "")
strFile = Replace(strFile, " ", "_")

DoCmd.TransferSpreadsheet acExport, 8, tblName, strPath & strFile, True

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strPath & strFile)
Set xlWs = xlWb.ActiveSheet
Set xlrng = xlWs.Range("A1:Z1")

xlApp.Visible = False
xlWs.Columns.AutoFit
'xlWs.Columns(14).Width = xlWs.Columns(12).Width

With xlWs
For I = 1 To 1
.Columns(I).Hidden = True
Next I

'Unlock AE Cells
For I = 14 To 18
.Columns(I).ColumnWidth = 17
Next I
.Columns(16).ColumnWidth = 125
.Protect UserInterfaceOnly:=True
.Cells.Locked = False


'Lock all cells that are not AE cells
For I = 1 To 13
.Columns(I).ColumnWidth = 17
Next I
.Columns(16).ColumnWidth = 125
.Protect UserInterfaceOnly:=True
.Cells.Locked = True 'lock all cells on sheet 1-13 (A:M)
End With
With xlrng
.Font.Bold = True
.Borders.LineStyle = xlContinuous
'.Borders.LineStyle = xlMedium
.BorderAround xlContinuous, xlThick, 0
.Locked = True
End With

xlWb.Close savechanges:=True
xlApp.Quit
MsgBox "Data has been exported!"
End If
End Sub
******************************************

Can some one help
thanks
 
A

Al

Steve,
thank you very much! This helps a lot. here is what worked and what didn't
1) locking selective cells works the way I want.
2) wrapping cells does not. I did not see any line in the code that takes
care of it. Column L and P have very long text and need to be wrapped. I
tried to wrap them in my code but for some reason it did don't do that? any
idea?
thanks Again
Al

Steve Sanford said:
Try this: (watch for line wrap)

Private Sub cmdExport_Click()
Dim strPath As String, wsData As Worksheet, strFile As String, tblName As
String, I As Integer
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Worksheet
Dim xlrng As Range

If IsNull(Me.txtPath) Then
Me.cmdExport.Enabled = True
Me.cmdExport.SetFocus
Me.cmdGo.Enabled = False
MsgBox "Please enter valid path then click <Re-Export>"
Exit Sub
End If

tblName = Me.txtFile
strPath = Me.txtPath
strFile = Replace([txtFile], ":", "")
strFile = Replace(strFile, "/", "")
strFile = Replace(strFile, " ", "_")

DoCmd.TransferSpreadsheet acExport, 8, tblName, strPath & strFile, True

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strPath & strFile)
Set xlWs = ActiveSheet
Set xlrng = Range("A1:Z1")

xlApp.Visible = False
xlWs.Columns.AutoFit
'xlWs.Columns(14).Width = xlWs.Columns(12).Width

With xlWs

'lock all cells on worksheet
.Cells.Locked = True

'set column widths
For I = 1 To 13
.Columns(I).ColumnWidth = 17
Next I

For I = 14 To 18
'set column widths
.Columns(I).ColumnWidth = 17
'Unlock Cells
.Columns(I).Cells.Locked = False
Next I
.Columns(16).ColumnWidth = 125

'hide column A
.Columns(1).Hidden = True
' For I = 1 To 1
' .Columns(I).Hidden = True
' Next I
End With

With xlrng
.Font.Bold = True
.Borders.LineStyle = xlContinuous
'.Borders.LineStyle = xlMedium
.BorderAround xlContinuous, xlThick, 0
.Locked = True
End With

'protect worksheet
xlWs.Protect UserInterfaceOnly:=True

xlWb.Close savechanges:=True
xlApp.Quit
MsgBox "Data has been exported!"

End Sub



HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


Al said:
I am exporting a table from Access to Excel for some one who is going to make
comments in specific columns then I import the excel file back to access with
the comments. The system works OK importing and Exporting however, I am
trying to lock columns A:M and unlock N:R for the Responder to write their
comments. I am also trying to wrap text on all cells. below see the code.
***********************************************
Private Sub cmdExport_Click()
Dim strPath As String, wsData As Worksheet, strFile As String, tblName
As String, I As Integer
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim xlrng As Excel.Range

If IsNull(txtPath) Then
Me.cmdExport.Enabled = True
Me.cmdExport.SetFocus
Me.cmdGo.Enabled = False
MsgBox "Please enter valid path then click <Re-Export>"
Exit Sub
Else
tblName = Me.txtFile
strPath = Me.txtPath
strFile = Replace([txtFile], ":", "")
strFile = Replace(strFile, "/", "")
strFile = Replace(strFile, " ", "_")

DoCmd.TransferSpreadsheet acExport, 8, tblName, strPath & strFile, True

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strPath & strFile)
Set xlWs = xlWb.ActiveSheet
Set xlrng = xlWs.Range("A1:Z1")

xlApp.Visible = False
xlWs.Columns.AutoFit
'xlWs.Columns(14).Width = xlWs.Columns(12).Width

With xlWs
For I = 1 To 1
.Columns(I).Hidden = True
Next I

'Unlock AE Cells
For I = 14 To 18
.Columns(I).ColumnWidth = 17
Next I
.Columns(16).ColumnWidth = 125
.Protect UserInterfaceOnly:=True
.Cells.Locked = False


'Lock all cells that are not AE cells
For I = 1 To 13
.Columns(I).ColumnWidth = 17
Next I
.Columns(16).ColumnWidth = 125
.Protect UserInterfaceOnly:=True
.Cells.Locked = True 'lock all cells on sheet 1-13 (A:M)
End With
With xlrng
.Font.Bold = True
.Borders.LineStyle = xlContinuous
'.Borders.LineStyle = xlMedium
.BorderAround xlContinuous, xlThick, 0
.Locked = True
End With

xlWb.Close savechanges:=True
xlApp.Quit
MsgBox "Data has been exported!"
End If
End Sub
******************************************

Can some one help
thanks
 
A

Al

Steve,
after doing some more testing, I found out that the code does not close
Excel properly. It stays hanging in the back ground. Therefore, the code
works the first time it runs exactly how I want it but then if I want to run
it again I get messages like "remote server does not exist". I did not have
this happening before. Is there something in your code that may be causing
this. I looked at both codes side by side and saw where you made some changes
but I did not see why this is happening? any idea? After I run the code I
have to press control alt delete to go to the task list to close Excel or I
get some problems as I mentioned above.

Steve Sanford said:
Try this: (watch for line wrap)

Private Sub cmdExport_Click()
Dim strPath As String, wsData As Worksheet, strFile As String, tblName As
String, I As Integer
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Worksheet
Dim xlrng As Range

If IsNull(Me.txtPath) Then
Me.cmdExport.Enabled = True
Me.cmdExport.SetFocus
Me.cmdGo.Enabled = False
MsgBox "Please enter valid path then click <Re-Export>"
Exit Sub
End If

tblName = Me.txtFile
strPath = Me.txtPath
strFile = Replace([txtFile], ":", "")
strFile = Replace(strFile, "/", "")
strFile = Replace(strFile, " ", "_")

DoCmd.TransferSpreadsheet acExport, 8, tblName, strPath & strFile, True

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strPath & strFile)
Set xlWs = ActiveSheet
Set xlrng = Range("A1:Z1")

xlApp.Visible = False
xlWs.Columns.AutoFit
'xlWs.Columns(14).Width = xlWs.Columns(12).Width

With xlWs

'lock all cells on worksheet
.Cells.Locked = True

'set column widths
For I = 1 To 13
.Columns(I).ColumnWidth = 17
Next I

For I = 14 To 18
'set column widths
.Columns(I).ColumnWidth = 17
'Unlock Cells
.Columns(I).Cells.Locked = False
Next I
.Columns(16).ColumnWidth = 125

'hide column A
.Columns(1).Hidden = True
' For I = 1 To 1
' .Columns(I).Hidden = True
' Next I
End With

With xlrng
.Font.Bold = True
.Borders.LineStyle = xlContinuous
'.Borders.LineStyle = xlMedium
.BorderAround xlContinuous, xlThick, 0
.Locked = True
End With

'protect worksheet
xlWs.Protect UserInterfaceOnly:=True

xlWb.Close savechanges:=True
xlApp.Quit
MsgBox "Data has been exported!"

End Sub



HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


Al said:
I am exporting a table from Access to Excel for some one who is going to make
comments in specific columns then I import the excel file back to access with
the comments. The system works OK importing and Exporting however, I am
trying to lock columns A:M and unlock N:R for the Responder to write their
comments. I am also trying to wrap text on all cells. below see the code.
***********************************************
Private Sub cmdExport_Click()
Dim strPath As String, wsData As Worksheet, strFile As String, tblName
As String, I As Integer
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim xlrng As Excel.Range

If IsNull(txtPath) Then
Me.cmdExport.Enabled = True
Me.cmdExport.SetFocus
Me.cmdGo.Enabled = False
MsgBox "Please enter valid path then click <Re-Export>"
Exit Sub
Else
tblName = Me.txtFile
strPath = Me.txtPath
strFile = Replace([txtFile], ":", "")
strFile = Replace(strFile, "/", "")
strFile = Replace(strFile, " ", "_")

DoCmd.TransferSpreadsheet acExport, 8, tblName, strPath & strFile, True

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strPath & strFile)
Set xlWs = xlWb.ActiveSheet
Set xlrng = xlWs.Range("A1:Z1")

xlApp.Visible = False
xlWs.Columns.AutoFit
'xlWs.Columns(14).Width = xlWs.Columns(12).Width

With xlWs
For I = 1 To 1
.Columns(I).Hidden = True
Next I

'Unlock AE Cells
For I = 14 To 18
.Columns(I).ColumnWidth = 17
Next I
.Columns(16).ColumnWidth = 125
.Protect UserInterfaceOnly:=True
.Cells.Locked = False


'Lock all cells that are not AE cells
For I = 1 To 13
.Columns(I).ColumnWidth = 17
Next I
.Columns(16).ColumnWidth = 125
.Protect UserInterfaceOnly:=True
.Cells.Locked = True 'lock all cells on sheet 1-13 (A:M)
End With
With xlrng
.Font.Bold = True
.Borders.LineStyle = xlContinuous
'.Borders.LineStyle = xlMedium
.BorderAround xlContinuous, xlThick, 0
.Locked = True
End With

xlWb.Close savechanges:=True
xlApp.Quit
MsgBox "Data has been exported!"
End If
End Sub
******************************************

Can some one help
thanks
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top