Populate ThisWorkbook via Code

S

Sean

I am trying to insert via code, code into ThisWorkbook. I have read
Chip Pearson site and seen some examples by Bob Phillips which I am
trying to replicate without much look. I returns a syntax error. I am
aware of the Trusted VBA and Reference to Microsoft VBA Extensibility.
The code I am running is as follows. Could anyone assist?




Sub Populate_TW()

Dim StartLine As Long

With
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
.InsertLines StartLine, _
"Application.ScreenUpdating = False"& vbCrLf & _
"Dim sh As Worksheet"& vbCrLf & _
"For Each sh In ThisWorkbook.Worksheets"& vbCrLf & _
"sh.Select"& vbCrLf & _
"Application.GoTo Reference:=sh.Range("a1"), Scroll:=True"& vbCrLf &
_
"Next sh"& vbCrLf & _
"ThisWorkbook.Sheets("Input").Select"& vbCrLf & _
"Application.ScreenUpdating = True"& vbCrLf & _
"Dim myArray As Variant"& vbCrLf & _
"Dim arName As String"& vbCrLf & _
"arName = "Users""& vbCrLf & _
"myArray = ThisWorkbook.Names(arName).RefersToRange.Value"& vbCrLf & _
"With Application"& vbCrLf & _
"If IsError(.Match(.UserName, myArray, 0)) Then"& vbCrLf & _
"ThisWorkbook.Sheets("Blank Sheet").Select"& vbCrLf &_
"MsgBox "You are NOT Permitted to access this File " & vbNewLine & _"&
vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""Please Contact " & vbNewLine & _"& vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""Joe Bloggs at " & vbNewLine & _"& vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""ABCGroup +0019 69944000""& vbCrLf & _
"Application.DisplayAlerts = False"& vbCrLf & _
"ThisWorkbook.Close False"& vbCrLf & _
"Else"& vbCrLf & _
"End If"& vbCrLf & _
"End With"& vbCrLf & _
"ThisWorkbook.Sheets("Input").Select"
End Sub
 
C

Chip Pearson

Sean,

You've got too many line continuations and you haven't properly used quotes.
Rather than trying to build the entire event procedure code with so many
line continuations, you'll find it MUCH easier to create and maintains the
code if you build it up line by line. E.g.,

Dim S As String
S = "first line" & vbCrLf
S = S & "next line" & vbCrLf
S = S & "another line" & vbCrLf
' and so on

This will make life MUCH simpler.

Also, you're not using quotes properly. To include a quote mark within the
string, you must use two quote characters. E.g.,

Dim S As String
S = "This ""word"" is quoted."
Debug.Print S


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)
 
G

Greg Wilson

I took some liberty with your code and made a few changes. The main problems
were that quoted text withing quotes must have double quotes. Also, you had
too many line continuations which raised an error. I split it up into two
strings to avoid this. Very little testing.

Sub Populate_TW()
Dim StartLine As Long
Dim msg1 As String, msg2 As String

msg1 = "Dim sh As Worksheet" & vbCr & _
"Dim myArray As Variant" & vbCr & _
"Application.ScreenUpdating = False" & vbCr & _
"For Each sh In ThisWorkbook.Worksheets" & vbCr & _
"sh.Select" & vbCr & _
"Application.GoTo Reference:=sh.Range(""a1""), Scroll:=True" & vbCr & _
"Next sh" & vbCr & _
"ThisWorkbook.Sheets(""Input"").Select" & vbCr & _
"Application.ScreenUpdating = True" & vbCr & _
"myArray = Range(""Users"").Value"

msg2 = "With Application" & vbCr & _
"If IsError(.Match(.UserName, myArray, 0)) Then" & vbCr & _
"ThisWorkbook.Sheets(""Blank Sheet"").Select" & vbCr & _
"MsgBox ""You are NOT Permitted to access this File "" & vbCr & _" & vbCr & _
"""Please Contact Joe Bloggs at "" & vbCr & _" & vbCr & _
"""ABCGroup +0019 69944000""" & vbCr & _
"ThisWorkbook.Sheets(""Input"").Select" & vbCr & _
"Application.DisplayAlerts = False" & vbCr & _
"ThisWorkbook.Close False" & vbCr & _
"End If" & vbCr & _
"End With"

With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
..InsertLines StartLine, msg1 & vbCr & msg2
End With
End Sub

Regards,
Greg
 
S

Sean

Thanks Guys. I wasn't aware that there was a limit on the continuation
lines, how many is it?
 
S

Sean

Guys I'm delighted with the result. I runthe following code as part of
another module and it works as I like, apart for one issue. When I run
it, the Microsoft Visual Basic project window remains open, why is that
and how can I close it?

Sub Populate_TW()
Dim StartLine As Long
Dim msg1 As String, msg2 As String


msg1 = "Dim sh As Worksheet" & vbCr & _
"With Application" & vbCr & _
"If .UserName = ""John"" Or .UserName = ""Joe"" Or .UserName =
""Johnny"" Then"


msg2 = "ThisWorkbook.Sheets(""E-Mail"").Select" & vbCr & _
"Else" & vbCr & _
"ThisWorkbook.Sheets(""E-Blank"").Select" & vbCr & _
"MsgBox ""You are NOT Permitted to access this File "" & vbCr & _" &
vbCr & _
""""" & vbCr & _" & vbCr & _
"""Please Contact Joe Bloggs at "" & vbCr & _" & vbCr & _
""""" & vbCr & _" & vbCr & _
"""ABC Group +0019 69944000""" & vbCr & _
"ThisWorkbook.Sheets(""E-Mail"").Select" & vbCr & _
"Application.DisplayAlerts = False" & vbCr & _
"ThisWorkbook.Close False" & vbCr & _
"End If" & vbCr & _
"End With"


With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
..InsertLines StartLine, msg1 & vbCr & msg2
End With
End Sub
 
S

Sean

I've hit a snag, with addingto my permitted list within the code, I'm
sure its about continuation of lines but can't figure it out, here is
the problem lines. In effect I've 2 lines of users

"If .UserName = ""User1"" Or .UserName = ""User2"" Or .UserName =
""User3"" Or .UserName = ""User4"" Or .UserName = ""User5"" Or
..UserName = ""User6"" Or .UserName = ""User7"" & vbCr & _" & vbCr & _
"If .UserName = ""User8"" Or .UserName = ""User9"" Or .UserName =
""User10"" Or .UserName = ""User11"" Or .UserName = ""User12"" Or
..UserName = ""User13"" Then"
 
C

Chip Pearson

Sean,

You would be MUCH better off using a Select Case statement. E.g.,

Select Case .UserName
Case "User1", "User2", "User3"
' do something
Case "User4", "User5", "User6"
' do something else
Case Else
' do something if no match above
End Select


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)
 
S

Sean

Chip, I placed the following code from your site but the Editor still
remains open once the code is completed. Not too worried about the
flicker

Sub Populate_TW()
Application.VBE.MainWindow.Visible = False
Dim StartLine As Long
Dim msg1 As String, msg2 As String

'
' My Code is in here
'
Application.VBE.MainWindow.Visible = True
End Sub
 
C

Chip Pearson

Sean,

Take out the line

Application.VBE.MainWindow.Visible = True

I have no idea what I was thinking when I put line of code on the web site.
I'll look back over the page to see if that line serves any purpose. I think
it is a mistake.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)
 
S

Sean

Chip I tried your other code but get a compile error "only comment may
appear after End sub etc". I placed it like the following

Sub Populate_TW()

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long


Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If

' My Code in Here

Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub
 
C

Chip Pearson

Sean,

The Private Declare statements must not be within a Sub or Function
procedure. They must appear outside of and above any procedure in the
module, right after "Option Explicit" (and you are using "Option Explicit"
aren't you?).


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)
 
S

Sean

Chip, I have no idea. But I did get it working, the way it is supposed
to, thanks for your guidance
 

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

Similar Threads

creating frame and option buttons programmatically 2
Excel crashes and restarts when accessing newly created worksheet 2
Xl 2007 v 2003 Re Populate ThisWorkbook via VBA 2
OssieMac help with code. 3
Populate ThisWorkbook Q 7
Trust Access to Visual Basic Project 0
Why am I getting "Code execution has been interrupted" message 4
Can somebody help me with this code? 4

Top