Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > allow change font while password pretected.
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 788
Default allow change font while password pretected.
Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris




Sub InsertRowsSASDeck()


Dim ar As Long
If Selection.Interior.ColorIndex < 36 _
Or Selection.Count 1 Then Exit Sub

ActiveSheet.Unprotect
ar = ActiveCell.Row
Selection.EntireRow.Insert
Cells(ar, "d").Formula = "=a" & ar & "*b" & ar & ""
Cells(ar, "i").Formula = "=a" & ar & "*e" & ar & ""
Cells(ar, "j").Formula = "=a" & ar & "*f" & ar & ""
Cells(ar, "k").Formula = "=a" & ar & "*g" & ar & ""

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub
Sub DeleteRowsSASdeck()
If Selection.Interior.ColorIndex < 36 Then Exit Sub
ActiveSheet.Unprotect

Selection.EntireRow.Delete

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True



End Sub


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 35,218
Default allow change font while password pretected.
First, you didn't say what you wanted to bold/change font color.

I'd record a macro to get the cells correct and the font color, too.

But you can use:
ActiveSheet.Unprotect password:="YourPasswordHere"
....your code
ActiveSheet.Protect _
password:="YourPasswordHere", _
DrawingObjects:=True, _



Chris wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris

Sub InsertRowsSASDeck()

Dim ar As Long
If Selection.Interior.ColorIndex < 36 _
Or Selection.Count 1 Then Exit Sub

ActiveSheet.Unprotect
ar = ActiveCell.Row
Selection.EntireRow.Insert
Cells(ar, "d").Formula = "=a" & ar & "*b" & ar & ""
Cells(ar, "i").Formula = "=a" & ar & "*e" & ar & ""
Cells(ar, "j").Formula = "=a" & ar & "*f" & ar & ""
Cells(ar, "k").Formula = "=a" & ar & "*g" & ar & ""

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub
Sub DeleteRowsSASdeck()
If Selection.Interior.ColorIndex < 36 Then Exit Sub
ActiveSheet.Unprotect

Selection.EntireRow.Delete

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True



End Sub

--

Dave Peterson
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 11,501
Default allow change font while password pretected.
Chris,

I'm not sure I understand but you can use a password with VB

ActiveSheet.Unprotect password:="MyPass"

and likewise

ActiveSheet.protect password:="MyPass"
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Chris" wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris




Sub InsertRowsSASDeck()


Dim ar As Long
If Selection.Interior.ColorIndex < 36 _
Or Selection.Count 1 Then Exit Sub

ActiveSheet.Unprotect
ar = ActiveCell.Row
Selection.EntireRow.Insert
Cells(ar, "d").Formula = "=a" & ar & "*b" & ar & ""
Cells(ar, "i").Formula = "=a" & ar & "*e" & ar & ""
Cells(ar, "j").Formula = "=a" & ar & "*f" & ar & ""
Cells(ar, "k").Formula = "=a" & ar & "*g" & ar & ""

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub
Sub DeleteRowsSASdeck()
If Selection.Interior.ColorIndex < 36 Then Exit Sub
ActiveSheet.Unprotect

Selection.EntireRow.Delete

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True



End Sub


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 788
Default allow change font while password pretected.
Thanks for that Dave.
I had been trying to change the colours of cell inputs and make bold. We
make the new items Red Bold and black bold for anything one day old then
black standard from then on. So this worked perfectly.
I had tryed to put it in myself the same but I was entering the
Activesheet.Protect_ password on the same line.

Regards
Chris

"Dave Peterson" wrote:

First, you didn't say what you wanted to bold/change font color.

I'd record a macro to get the cells correct and the font color, too.

But you can use:
ActiveSheet.Unprotect password:="YourPasswordHere"
....your code
ActiveSheet.Protect _
password:="YourPasswordHere", _
DrawingObjects:=True, _



Chris wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris

Sub InsertRowsSASDeck()

Dim ar As Long
If Selection.Interior.ColorIndex < 36 _
Or Selection.Count 1 Then Exit Sub

ActiveSheet.Unprotect
ar = ActiveCell.Row
Selection.EntireRow.Insert
Cells(ar, "d").Formula = "=a" & ar & "*b" & ar & ""
Cells(ar, "i").Formula = "=a" & ar & "*e" & ar & ""
Cells(ar, "j").Formula = "=a" & ar & "*f" & ar & ""
Cells(ar, "k").Formula = "=a" & ar & "*g" & ar & ""

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub
Sub DeleteRowsSASdeck()
If Selection.Interior.ColorIndex < 36 Then Exit Sub
ActiveSheet.Unprotect

Selection.EntireRow.Delete

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True



End Sub

--

Dave Peterson
.

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 788
Default allow change font while password pretected.
Hi
In the code below, section for amount of rows I would like to have a choise
of how meny rows to insert or delete each time, I have seen part of a code
that gives you this choise but I cant get it to do that. can You help.
Regards
Chris

"Dave Peterson" wrote:

First, you didn't say what you wanted to bold/change font color.

I'd record a macro to get the cells correct and the font color, too.

But you can use:
ActiveSheet.Unprotect password:="YourPasswordHere"
....your code
ActiveSheet.Protect _
password:="YourPasswordHere", _
DrawingObjects:=True, _



Chris wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris

Sub InsertRowsSASDeck()

Dim ar As Long
If Selection.Interior.ColorIndex < 36 _ !!!!!!!
Or Selection.Count 1 Then Exit Sub !!!!!!!

ActiveSheet.Unprotect
ar = ActiveCell.Row
Selection.EntireRow.Insert
Cells(ar, "d").Formula = "=a" & ar & "*b" & ar & ""
Cells(ar, "i").Formula = "=a" & ar & "*e" & ar & ""
Cells(ar, "j").Formula = "=a" & ar & "*f" & ar & ""
Cells(ar, "k").Formula = "=a" & ar & "*g" & ar & ""

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub
Sub DeleteRowsSASdeck()
If Selection.Interior.ColorIndex < 36 Then Exit Sub
ActiveSheet.Unprotect

Selection.EntireRow.Delete

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True



End Sub

--

Dave Peterson
.

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 35,218
Default allow change font while password pretected.
Option Explicit
Sub InsertRowsSASDeck()

Dim HowManyRows As Long
Dim myRow As Long
Dim myCell As Range

Set myCell = ActiveCell 'single cell
myRow = myCell.Row

If myCell.Interior.ColorIndex < 36 Then
Exit Sub
End If

HowManyRows = CLng(Application.InputBox(Prompt:="how many rows to insert", _
Type:=1))

If HowManyRows < 1 Then
Exit Sub
End If

'some sort of sanity check to stop typos
If HowManyRows 50 Then
Exit Sub
End If

With ActiveSheet
.Unprotect
.Cells(myRow, "A").Resize(HowManyRows, 1).EntireRow.Insert
.Cells(myRow, "D").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*b" & myRow
.Cells(myRow, "I").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*e" & myRow
.Cells(myRow, "J").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*f" & myRow
.Cells(myRow, "K").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*g" & myRow

.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End With

End Sub
Sub DeleteRowsSASdeck()

Dim HowManyRows As Long
Dim myRow As Long
Dim myCell As Range

Set myCell = ActiveCell 'single cell
myRow = myCell.Row

If myCell.Interior.ColorIndex < 36 Then
Exit Sub
End If

HowManyRows = CLng(Application.InputBox(Prompt:="how many rows to delete", _
Type:=1))

If HowManyRows < 1 Then
Exit Sub
End If

'some sort of sanity check to stop typos
If HowManyRows 50 Then
Exit Sub
End If

With ActiveSheet
.Unprotect
.Cells(myRow, "A").Resize(HowManyRows, 1).EntireRow.Delete
.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End With

End Sub



Chris wrote:

Hi
In the code below, section for amount of rows I would like to have a choise
of how meny rows to insert or delete each time, I have seen part of a code
that gives you this choise but I cant get it to do that. can You help.
Regards
Chris

"Dave Peterson" wrote:

First, you didn't say what you wanted to bold/change font color.

I'd record a macro to get the cells correct and the font color, too.

But you can use:
ActiveSheet.Unprotect password:="YourPasswordHere"
....your code
ActiveSheet.Protect _
password:="YourPasswordHere", _
DrawingObjects:=True, _



Chris wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris

Sub InsertRowsSASDeck()

Dim ar As Long
If Selection.Interior.ColorIndex < 36 _ !!!!!!!
Or Selection.Count 1 Then Exit Sub !!!!!!!

ActiveSheet.Unprotect
ar = ActiveCell.Row
Selection.EntireRow.Insert
Cells(ar, "d").Formula = "=a" & ar & "*b" & ar & ""
Cells(ar, "i").Formula = "=a" & ar & "*e" & ar & ""
Cells(ar, "j").Formula = "=a" & ar & "*f" & ar & ""
Cells(ar, "k").Formula = "=a" & ar & "*g" & ar & ""

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub
Sub DeleteRowsSASdeck()
If Selection.Interior.ColorIndex < 36 Then Exit Sub
ActiveSheet.Unprotect

Selection.EntireRow.Delete

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True



End Sub

--

Dave Peterson
.


--

Dave Peterson
Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 788
Default allow change font while password pretected.
Thanks again Dave

Perfect.

"Dave Peterson" wrote:

Option Explicit
Sub InsertRowsSASDeck()

Dim HowManyRows As Long
Dim myRow As Long
Dim myCell As Range

Set myCell = ActiveCell 'single cell
myRow = myCell.Row

If myCell.Interior.ColorIndex < 36 Then
Exit Sub
End If

HowManyRows = CLng(Application.InputBox(Prompt:="how many rows to insert", _
Type:=1))

If HowManyRows < 1 Then
Exit Sub
End If

'some sort of sanity check to stop typos
If HowManyRows 50 Then
Exit Sub
End If

With ActiveSheet
.Unprotect
.Cells(myRow, "A").Resize(HowManyRows, 1).EntireRow.Insert
.Cells(myRow, "D").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*b" & myRow
.Cells(myRow, "I").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*e" & myRow
.Cells(myRow, "J").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*f" & myRow
.Cells(myRow, "K").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*g" & myRow

.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End With

End Sub
Sub DeleteRowsSASdeck()

Dim HowManyRows As Long
Dim myRow As Long
Dim myCell As Range

Set myCell = ActiveCell 'single cell
myRow = myCell.Row

If myCell.Interior.ColorIndex < 36 Then
Exit Sub
End If

HowManyRows = CLng(Application.InputBox(Prompt:="how many rows to delete", _
Type:=1))

If HowManyRows < 1 Then
Exit Sub
End If

'some sort of sanity check to stop typos
If HowManyRows 50 Then
Exit Sub
End If

With ActiveSheet
.Unprotect
.Cells(myRow, "A").Resize(HowManyRows, 1).EntireRow.Delete
.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End With

End Sub



Chris wrote:

Hi
In the code below, section for amount of rows I would like to have a choise
of how meny rows to insert or delete each time, I have seen part of a code
that gives you this choise but I cant get it to do that. can You help.
Regards
Chris

"Dave Peterson" wrote:

First, you didn't say what you wanted to bold/change font color.

I'd record a macro to get the cells correct and the font color, too.

But you can use:
ActiveSheet.Unprotect password:="YourPasswordHere"
....your code
ActiveSheet.Protect _
password:="YourPasswordHere", _
DrawingObjects:=True, _



Chris wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris

Sub InsertRowsSASDeck()

Dim ar As Long
If Selection.Interior.ColorIndex < 36 _ !!!!!!!
Or Selection.Count 1 Then Exit Sub !!!!!!!

ActiveSheet.Unprotect
ar = ActiveCell.Row
Selection.EntireRow.Insert
Cells(ar, "d").Formula = "=a" & ar & "*b" & ar & ""
Cells(ar, "i").Formula = "=a" & ar & "*e" & ar & ""
Cells(ar, "j").Formula = "=a" & ar & "*f" & ar & ""
Cells(ar, "k").Formula = "=a" & ar & "*g" & ar & ""

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub
Sub DeleteRowsSASdeck()
If Selection.Interior.ColorIndex < 36 Then Exit Sub
ActiveSheet.Unprotect

Selection.EntireRow.Delete

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True



End Sub

--

Dave Peterson
.


--

Dave Peterson
.

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
macro that will change the font of a cell if i change a value jk Excel Discussion (Misc queries) 2 July 29th 08 04:39 PM
change scaling % but font size didnt change porportionally, pls he Scaling question Excel Discussion (Misc queries) 0 March 12th 07 03:16 AM
Change all text one font size up with various font sizes used. omchrystal New Users to Excel 2 March 6th 07 09:01 PM
Highlight entire document and try to change font - won't change. murzy03 Excel Discussion (Misc queries) 1 May 8th 06 07:05 PM
change display font to actual selected font Flannigan Excel Discussion (Misc queries) 1 August 30th 05 01:46 PM


All times are GMT +1. The time now is 11:11 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement