A
Alex
We are using a complex macro to handle importing into a retail item
database. When the program is run, three forms exist. A fourth form is
created through VBA using the following code while the program is
running:
Dim newButton As MSForms.CommandButton
Dim newLabel As MSForms.Label
Dim newCombo As MSForms.ComboBox
Dim rownum As Integer
Dim line As Integer
Dim formHeight As Integer
Dim scrollHeight As Integer
Dim X As Integer
Dim XMax As Integer
Dim excelName As String
Dim mapName As String
Dim excelID As String
Dim impColCount As Integer
Dim rst As ADODB.Recordset
userForm4Load = 1
If UserForm1.TextBox1.Enabled = True Then
excelName = Trim(UserForm1.TextBox1.Value)
Else
excelName = Trim(UserForm1.ComboBox1.Value)
End If
Set rst = New ADODB.Recordset
rst.ActiveConnection = conn
rst.Open "SELECT excel_id FROM excel WHERE name = '" & excelName &
"'"
excelID = rst("excel_id")
Set rst = New ADODB.Recordset
rst.ActiveConnection = conn
rst.Open "SELECT COUNT(excel_detail_id) AS count FROM excel_detail
WHERE excel_id = " & excelID
impColCount = rst("count")
If impColCount > 0 Then
XMax = impColCount - 1
Else
XMax = colCount - 1
End If
formHeight = 98
For X = 0 To XMax
If formHeight < 367 Then
formHeight = formHeight + 24
Else
Exit For
End If
Next
scrollHeight = 98
For X = 0 To XMax
scrollHeight = scrollHeight + 24
Next
'This is to stop screen flashing while creating form
Application.VBE.MainWindow.Visible = False
Set tempForm = ThisWorkbook.VBProject.VBComponents.add(3)
'Create the User Form
With tempForm
.Properties("Caption") = excelName & ": Map Columns"
.Properties("Width") = 461.5
.Properties("Height") = formHeight
.Properties("BackColor") = &HFFC0C0
.Properties("ScrollBars") = fmScrollBarsVertical
.Properties("ScrollHeight") = scrollHeight
.Properties("Visible") = False
End With
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
With newLabel
.Name = "MainLabel"
.Caption = "Map the columns below to the appropriate fields.
Required fields are indicated by an asterisk (*) after the column
description. Each column may only be assigned to one field."
.Top = 0
.Left = 12
.Width = 420
.Height = 24
.BackColor = &HC0C0C0
.BorderStyle = fmBorderStyleSingle
.TextAlign = fmTextAlignCenter
End With
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
With newLabel
.Name = "Col1Label"
.Caption = "Column Names"
.Font.Bold = True
.Top = 24
.Left = 18
.Width = 120
.Height = 12
.TextAlign = fmTextAlignCenter
End With
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
With newLabel
.Name = "Col2Label"
.Caption = "Sample Data"
.Font.Bold = True
.Top = 24
.Left = 162
.Width = 120
.Height = 12
.TextAlign = fmTextAlignCenter
End With
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
With newLabel
.Name = "Col3Label"
.Caption = "RMS Data Field"
.Font.Bold = True
.Top = 24
.Left = 306
.Width = 120
.Height = 12
.TextAlign = fmTextAlignCenter
End With
Set newButton =
tempForm.designer.Controls.add("Forms.commandbutton.1")
With newButton
.Name = "CommandButton1"
.Caption = "< Back"
.Top = 48 + (24 * X)
.Left = 18
.Width = 78
.Height = 24
End With
Set newButton =
tempForm.designer.Controls.add("Forms.commandbutton.1")
With newButton
.Name = "CommandButton2"
.Caption = "Cancel..."
.Top = 48 + (24 * X)
.Left = 183
.Width = 78
.Height = 24
End With
Set newButton =
tempForm.designer.Controls.add("Forms.commandbutton.1")
With newButton
.Name = "CommandButton3"
.Caption = "Finish Import"
.Top = 48 + (24 * X)
.Left = 348
.Width = 78
.Height = 24
End With
'Create Column 1 Labels
If UserForm3.OptionButton2.Value = False Then
For X = 0 To XMax
Set newLabel = tempForm.designer.Controls.add("Forms.label.
1")
With newLabel
.Name = "Label" & X + 1
.Caption = Left(Trim(cells(9, X + 1).Value), 30)
.Top = 24 + (24 * (X + 1))
.Left = 18
.Width = 120
.Height = 12
End With
Next
Else
For X = 0 To XMax
Set newLabel = tempForm.designer.Controls.add("Forms.label.
1")
With newLabel
.Name = "Label" & X + 1
.Caption = "Column " & X + 1
.Top = 24 + (24 * (X + 1))
.Left = 18
.Width = 120
.Height = 12
End With
Next
End If
'Create Column 2 Labels
For X = 0 To XMax
If UserForm3.OptionButton2.Value = False Then
rownum = 10
Else
rownum = 9
End If
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
Do Until cells(rownum, X + 1).Value <> Empty Or rownum = 2000
rownum = rownum + 1
Loop
With newLabel
.Name = "Label" & X + 1001
.Caption = Left(Trim(cells(rownum, X + 1).Value), 30)
.Top = 24 + (24 * (X + 1))
.Left = 162
.Width = 120
.Height = 12
End With
Next
Dim test As String
'Create Column 3 Combo Boxes
If impColCount > 0 Then
For X = 0 To XMax
Set rst = New ADODB.Recordset
rst.ActiveConnection = conn
rst.Open "SELECT i.imp_col_label FROM imp_col i,
excel_detail e WHERE e.imp_col_id = i.imp_col_id AND e.excel_id = " &
excelID & " AND e.xls_col_index = " & X + 1
mapName = rst("imp_col_label")
Set newCombo =
tempForm.designer.Controls.add("Forms.combobox.1")
With newCombo
.Name = "ComboBox" & X + 1
.Value = Trim(mapName)
.TabIndex = X
.Top = 18 + (24 * (X + 1))
.Left = 306
.Width = 120
.Height = 18
.RowSource = "Data!B1:B49"
End With
Next
Else
For X = 0 To XMax
Set newCombo =
tempForm.designer.Controls.add("Forms.combobox.1")
With newCombo
.Name = "ComboBox" & X + 1
.Value = "(Ignore)"
.Top = 18 + (24 * (X + 1))
.Left = 306
.TabIndex = X
.Width = 120
.Height = 18
.RowSource = "Data!B1:B48"
End With
Next
End If
With tempForm.codemodule
line = .countoflines
.insertlines line + 1, "Sub CommandButton1_Click"
.insertlines line + 2, "UserForm4.Hide"
.insertlines line + 3, "UserForm3.Show"
.insertlines line + 4, "End Sub"
.insertlines line + 5, "Sub CommandButton2_Click"
.insertlines line + 6, "loadLine = 0"
.insertlines line + 7,
"ThisWorkbook.VBProject.VBComponents.Remove tempForm"
.insertlines line + 8, "Unload UserForm1"
.insertlines line + 9, "Unload UserForm2"
.insertlines line + 10, "Unload UserForm3"
.insertlines line + 11, "Unload UserForm4"
.insertlines line + 12, "End Sub"
.insertlines line + 13, "Sub CommandButton3_Click"
.insertlines line + 14, "handleUserForm4"
.insertlines line + 15, "End Sub"
End With
'Show the form using differenet sub
VBA.UserForms.add (tempForm.Name)
showUserForm4
I can then show and hide the form using "UserForm4.Show" and
"UserForm4.Hide". The form is removed when the program is finished
running (it is built on user inputs so it needs to be recreated every
time).
My trouble is that I need to password protect this vba script to
prevent unauthorized edits / access. I can't because the variable
"UserForm4" is not defined and the compiler does not recognize it as a
valid object because it does not exist until the middle of the script.
I have tried defining the variable as an object, but as soon as I do
that, the form will create but not show.
Any ideas?
-- Alex Nielsen
database. When the program is run, three forms exist. A fourth form is
created through VBA using the following code while the program is
running:
Dim newButton As MSForms.CommandButton
Dim newLabel As MSForms.Label
Dim newCombo As MSForms.ComboBox
Dim rownum As Integer
Dim line As Integer
Dim formHeight As Integer
Dim scrollHeight As Integer
Dim X As Integer
Dim XMax As Integer
Dim excelName As String
Dim mapName As String
Dim excelID As String
Dim impColCount As Integer
Dim rst As ADODB.Recordset
userForm4Load = 1
If UserForm1.TextBox1.Enabled = True Then
excelName = Trim(UserForm1.TextBox1.Value)
Else
excelName = Trim(UserForm1.ComboBox1.Value)
End If
Set rst = New ADODB.Recordset
rst.ActiveConnection = conn
rst.Open "SELECT excel_id FROM excel WHERE name = '" & excelName &
"'"
excelID = rst("excel_id")
Set rst = New ADODB.Recordset
rst.ActiveConnection = conn
rst.Open "SELECT COUNT(excel_detail_id) AS count FROM excel_detail
WHERE excel_id = " & excelID
impColCount = rst("count")
If impColCount > 0 Then
XMax = impColCount - 1
Else
XMax = colCount - 1
End If
formHeight = 98
For X = 0 To XMax
If formHeight < 367 Then
formHeight = formHeight + 24
Else
Exit For
End If
Next
scrollHeight = 98
For X = 0 To XMax
scrollHeight = scrollHeight + 24
Next
'This is to stop screen flashing while creating form
Application.VBE.MainWindow.Visible = False
Set tempForm = ThisWorkbook.VBProject.VBComponents.add(3)
'Create the User Form
With tempForm
.Properties("Caption") = excelName & ": Map Columns"
.Properties("Width") = 461.5
.Properties("Height") = formHeight
.Properties("BackColor") = &HFFC0C0
.Properties("ScrollBars") = fmScrollBarsVertical
.Properties("ScrollHeight") = scrollHeight
.Properties("Visible") = False
End With
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
With newLabel
.Name = "MainLabel"
.Caption = "Map the columns below to the appropriate fields.
Required fields are indicated by an asterisk (*) after the column
description. Each column may only be assigned to one field."
.Top = 0
.Left = 12
.Width = 420
.Height = 24
.BackColor = &HC0C0C0
.BorderStyle = fmBorderStyleSingle
.TextAlign = fmTextAlignCenter
End With
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
With newLabel
.Name = "Col1Label"
.Caption = "Column Names"
.Font.Bold = True
.Top = 24
.Left = 18
.Width = 120
.Height = 12
.TextAlign = fmTextAlignCenter
End With
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
With newLabel
.Name = "Col2Label"
.Caption = "Sample Data"
.Font.Bold = True
.Top = 24
.Left = 162
.Width = 120
.Height = 12
.TextAlign = fmTextAlignCenter
End With
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
With newLabel
.Name = "Col3Label"
.Caption = "RMS Data Field"
.Font.Bold = True
.Top = 24
.Left = 306
.Width = 120
.Height = 12
.TextAlign = fmTextAlignCenter
End With
Set newButton =
tempForm.designer.Controls.add("Forms.commandbutton.1")
With newButton
.Name = "CommandButton1"
.Caption = "< Back"
.Top = 48 + (24 * X)
.Left = 18
.Width = 78
.Height = 24
End With
Set newButton =
tempForm.designer.Controls.add("Forms.commandbutton.1")
With newButton
.Name = "CommandButton2"
.Caption = "Cancel..."
.Top = 48 + (24 * X)
.Left = 183
.Width = 78
.Height = 24
End With
Set newButton =
tempForm.designer.Controls.add("Forms.commandbutton.1")
With newButton
.Name = "CommandButton3"
.Caption = "Finish Import"
.Top = 48 + (24 * X)
.Left = 348
.Width = 78
.Height = 24
End With
'Create Column 1 Labels
If UserForm3.OptionButton2.Value = False Then
For X = 0 To XMax
Set newLabel = tempForm.designer.Controls.add("Forms.label.
1")
With newLabel
.Name = "Label" & X + 1
.Caption = Left(Trim(cells(9, X + 1).Value), 30)
.Top = 24 + (24 * (X + 1))
.Left = 18
.Width = 120
.Height = 12
End With
Next
Else
For X = 0 To XMax
Set newLabel = tempForm.designer.Controls.add("Forms.label.
1")
With newLabel
.Name = "Label" & X + 1
.Caption = "Column " & X + 1
.Top = 24 + (24 * (X + 1))
.Left = 18
.Width = 120
.Height = 12
End With
Next
End If
'Create Column 2 Labels
For X = 0 To XMax
If UserForm3.OptionButton2.Value = False Then
rownum = 10
Else
rownum = 9
End If
Set newLabel = tempForm.designer.Controls.add("Forms.label.1")
Do Until cells(rownum, X + 1).Value <> Empty Or rownum = 2000
rownum = rownum + 1
Loop
With newLabel
.Name = "Label" & X + 1001
.Caption = Left(Trim(cells(rownum, X + 1).Value), 30)
.Top = 24 + (24 * (X + 1))
.Left = 162
.Width = 120
.Height = 12
End With
Next
Dim test As String
'Create Column 3 Combo Boxes
If impColCount > 0 Then
For X = 0 To XMax
Set rst = New ADODB.Recordset
rst.ActiveConnection = conn
rst.Open "SELECT i.imp_col_label FROM imp_col i,
excel_detail e WHERE e.imp_col_id = i.imp_col_id AND e.excel_id = " &
excelID & " AND e.xls_col_index = " & X + 1
mapName = rst("imp_col_label")
Set newCombo =
tempForm.designer.Controls.add("Forms.combobox.1")
With newCombo
.Name = "ComboBox" & X + 1
.Value = Trim(mapName)
.TabIndex = X
.Top = 18 + (24 * (X + 1))
.Left = 306
.Width = 120
.Height = 18
.RowSource = "Data!B1:B49"
End With
Next
Else
For X = 0 To XMax
Set newCombo =
tempForm.designer.Controls.add("Forms.combobox.1")
With newCombo
.Name = "ComboBox" & X + 1
.Value = "(Ignore)"
.Top = 18 + (24 * (X + 1))
.Left = 306
.TabIndex = X
.Width = 120
.Height = 18
.RowSource = "Data!B1:B48"
End With
Next
End If
With tempForm.codemodule
line = .countoflines
.insertlines line + 1, "Sub CommandButton1_Click"
.insertlines line + 2, "UserForm4.Hide"
.insertlines line + 3, "UserForm3.Show"
.insertlines line + 4, "End Sub"
.insertlines line + 5, "Sub CommandButton2_Click"
.insertlines line + 6, "loadLine = 0"
.insertlines line + 7,
"ThisWorkbook.VBProject.VBComponents.Remove tempForm"
.insertlines line + 8, "Unload UserForm1"
.insertlines line + 9, "Unload UserForm2"
.insertlines line + 10, "Unload UserForm3"
.insertlines line + 11, "Unload UserForm4"
.insertlines line + 12, "End Sub"
.insertlines line + 13, "Sub CommandButton3_Click"
.insertlines line + 14, "handleUserForm4"
.insertlines line + 15, "End Sub"
End With
'Show the form using differenet sub
VBA.UserForms.add (tempForm.Name)
showUserForm4
I can then show and hide the form using "UserForm4.Show" and
"UserForm4.Hide". The form is removed when the program is finished
running (it is built on user inputs so it needs to be recreated every
time).
My trouble is that I need to password protect this vba script to
prevent unauthorized edits / access. I can't because the variable
"UserForm4" is not defined and the compiler does not recognize it as a
valid object because it does not exist until the middle of the script.
I have tried defining the variable as an object, but as soon as I do
that, the form will create but not show.
Any ideas?
-- Alex Nielsen