wolf.stalker
09-24-2008, 04:38 AM
let me see if i can "explain" what I am trying to do before posting the code. I thought I had this figured out...but opps :bug: ....i was wrong.
One of my procedures takes all the worksheets in my workbook, and turns each sheet into it's own workbook. the code i have does this part nicely.
With the help of a fellow user :friends: (GTO), I was able to solve how to procect my vba project through a macro using sendkeys.
now i am trying to tie the two together. i would like for my macro that turns worksheets into workbooks to also add the code that protects vbaprojects in the "ThisWorkbook" object as it will need to run on a workbook open feature. How might I go about doing this?
here is part of the code for building workbooks from worksheets
For Each wkSheet In CurWkbook.Worksheets
If wkSheet.Index < 5 Then
'do nothing
Else
shtcnt(1) = (6)
Application.StatusBar = shtcnt(1) & "/" & shtcnt(2) & _
" " & wkSheet.Name ' so we can see whats going on in status bar
wkSheetName = Trim(wkSheet.Name) 'get name of worksheet
wkSheetName = wkSheetName & " " & dtimestamp 'add date stamp to worksheet name
Workbooks.Add ' auto build a new workbook
ActiveWorkbook.SaveAs _
Filename:=xpathname & wkSheetName & ".xls", _
FileFormat:=xlNormal, Password:="", _
WriteResPassword:="", CreateBackup:=False, _
ReadOnlyRecommended:=False 'how we save new workbook with name and stuff
Set newWkbook = ActiveWorkbook
Application.DisplayAlerts = False
newWkbook.Worksheets("sheet1").Delete ' remove sheet1
On Error Resume Next
newWkbook.Worksheets(wkSheet.Name).Delete
On Error GoTo 0
Application.DisplayAlerts = True
CurWkbook.Worksheets(wkSheet.Name).Copy before:=newWkbook.Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next wkSheet
Here is code for using send keys to lock vbaproject
Private Sub workbook_open()
With Application
.VBE.mainwindow.Visible = True
.VBE.CommandBars("Menu Bar").Controls("Tools").Controls("VBAProject Properties...").Execute
.SendKeys "^{TAB}"
.SendKeys "{ }"
.SendKeys "{TAB}" & "123"
.SendKeys "{TAB}" & "123"
.SendKeys "{TAB}"
.SendKeys "{ENTER}"
.VBE.mainwindow.Visible = False
End With
End Sub
and if it's not to much trouble, is there a way to check to see if vbaproject is protected before workbook_open ? i have been testing it and i keep getting promted for password which means i think i might be stuck there too. i can always live with the user getting prompted for password i guess when they open up workbook :-D
One of my procedures takes all the worksheets in my workbook, and turns each sheet into it's own workbook. the code i have does this part nicely.
With the help of a fellow user :friends: (GTO), I was able to solve how to procect my vba project through a macro using sendkeys.
now i am trying to tie the two together. i would like for my macro that turns worksheets into workbooks to also add the code that protects vbaprojects in the "ThisWorkbook" object as it will need to run on a workbook open feature. How might I go about doing this?
here is part of the code for building workbooks from worksheets
For Each wkSheet In CurWkbook.Worksheets
If wkSheet.Index < 5 Then
'do nothing
Else
shtcnt(1) = (6)
Application.StatusBar = shtcnt(1) & "/" & shtcnt(2) & _
" " & wkSheet.Name ' so we can see whats going on in status bar
wkSheetName = Trim(wkSheet.Name) 'get name of worksheet
wkSheetName = wkSheetName & " " & dtimestamp 'add date stamp to worksheet name
Workbooks.Add ' auto build a new workbook
ActiveWorkbook.SaveAs _
Filename:=xpathname & wkSheetName & ".xls", _
FileFormat:=xlNormal, Password:="", _
WriteResPassword:="", CreateBackup:=False, _
ReadOnlyRecommended:=False 'how we save new workbook with name and stuff
Set newWkbook = ActiveWorkbook
Application.DisplayAlerts = False
newWkbook.Worksheets("sheet1").Delete ' remove sheet1
On Error Resume Next
newWkbook.Worksheets(wkSheet.Name).Delete
On Error GoTo 0
Application.DisplayAlerts = True
CurWkbook.Worksheets(wkSheet.Name).Copy before:=newWkbook.Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next wkSheet
Here is code for using send keys to lock vbaproject
Private Sub workbook_open()
With Application
.VBE.mainwindow.Visible = True
.VBE.CommandBars("Menu Bar").Controls("Tools").Controls("VBAProject Properties...").Execute
.SendKeys "^{TAB}"
.SendKeys "{ }"
.SendKeys "{TAB}" & "123"
.SendKeys "{TAB}" & "123"
.SendKeys "{TAB}"
.SendKeys "{ENTER}"
.VBE.mainwindow.Visible = False
End With
End Sub
and if it's not to much trouble, is there a way to check to see if vbaproject is protected before workbook_open ? i have been testing it and i keep getting promted for password which means i think i might be stuck there too. i can always live with the user getting prompted for password i guess when they open up workbook :-D