PDA

View Full Version : Write to Module Using VBA



SamT
03-30-2010, 01:33 PM
I'm writing a KB entry titled "Excel and 16 Million Colors." It will show manipulating Cell Colors and allow the user to view and select certain colors to be used as Constants in their procedures. It will illustrate the differences and relationships between "Range.Interior.ColorIndex," "Range.Interior.Color," and Hex Coded color values used in HTML. It will also show the use of the RGB() Function and how it develops its output, how to reverse the RGB process and how to duplicate its functionality with Hex Values.

The first sheet in the Workbook is "Instructions" and is Activated on Workbook_Open. Another sheet is "Template." The instructions will direct the User to copy Sheet("Template") as often as needed and place certain values in Range("A3:B56"). My Code already sucessfully manipulates those values.

The areas I am having trouble with are the Selection process and the Write-to-Module process.

I have the code to develop the Variables holding the Constant Strings that will be written to the modules. The names of the three modules are "Hex_Constants," "Value_Constants," and "Index_Constants." The three Strings will be "HexString," "IndexString," and "ValueString."

I envision a "Start Selecting" and a "Done Selecting" CommandButton on Sheet("Instructions"). After the User clicks "Start Selecting" he/she can browse thru the worksheets and Multiselect various Rows between Row(3) and Row(56) inclusive.

PseudoCode for Selection Process


Dim ar_Rows_Selected(2,54) As Strings where the _
Strings in Col("A") and Col("B") are stored.
Dim Reserved as Enum or collection of worksheets. (Hardcoded)
Dim SelectionsCount as Long
Until "Done_Selecting" (See below)
While SelectionsCount <= 54
If ActiveSheet NOT Reserved Then
Allow MultiSelect in the Rows 3 to 56 only
Increment SelectionsCount by num rows selected
End If
Allow user to activate any other sheet.
If SelectionCount = 54 then
Force Click cmdbut_Done_Selecting (see below)
MsgBox("Warn User")

Wend
Loop 'Until

When the User clicks on the "Done_Selecting" button on Sheet("Instructions"), he/she must be offered the chance, (by UserForm?) to delete any selections from ar_Rows_Selected by reviewing and deselecting from the Col("A") String value. They don't need to see the Col("B") value.

After the User has reviewed their selections, they need to be offered the chance to add to their selections, if fewer than 54. When they are sure, they will click the Command Button "Save New Color Constants."

Then, I will process the Col("A") and Col("B") values and feed another array, ("ar_All_Constants") with the computed values of "HexString," "IndexString," and "ValueString."

Finally:
I will fill ar_Color_Values() As String with values computed from Col("B").
Then, I need to


For i = 1 To Ubound(ar_ColorValues)
MyString = ".Colors(" & i + 2 & ") = " & ar_Color_Values(i) & Chr(13)
'Write MyString to VBA Code below. Should be in Modules("Run_Me_Once"):
Next 1


Option Base 1
Sub Customize_Palette()
With ThisWorkbook
'[Write Above strings here]
'.Colors(3) = 11823615' Examples of Lines to write
'.Colors(4) = 9639167
'.Colors(5) = 13353215
End With
End Sub

I have to Clear the modules "Hex_Constants," "Value_Constants," and "Index_Constants" and write the values in the 3 column array "ar_All_Constants" to the respective modules. For this, I'm totally lost.

Here are examples of the strings I, will be generating and You will be writing:
ValueString = "Constant Hot_Pink As Long = 1823615"
IndexString = "Constant Hot_Pink_Index As Variant = 3"
HexString = "Constant Hot_Pink_Hex As String = "&HFFFFFF""

The User will manually copy/import all relevant modules to their workbook and run Sub Customize_Palette. Then they can use code like:

MyRange.Interior.Color = Hot_Pink

Selection.Row.Interior.ColorIndex = Hot_Pink_Index

With UserForm1.Controls
BackColor = Hot_Pink

My_HTML_String = "<Body BGColor="" & Hot_Pink_Hex & ">""

The user will deal with the copies of Sheet("Template").
Thanks,
SamT

PS: if the best way to allow the User to deselect is a UserForm, AND, you use individual labels or checkboxes, their BackColor's can be set = to the values in Col("B"), which will show them the color they are deselecting. st.

xld
03-30-2010, 03:34 PM
This should write the module code for you



Const vbext_ct_StdModule As Long = 1
Dim VBComp As Object

On Error Resume Next
Set VBComp = ThisWorkbook.VBProject.VBComponents("HexConstants")
On Error GoTo 0
If Not VBComp Is Nothing Then

ThisWorkbook.VBProject.VBComponents.Remove VBComp
End If

Set VBComp = ThisWorkbook.VBProject.VBComponents.Add(ComponentType:=vbext_ct_StdModule)
VBComp.Name = "HexConstants"
With VBComp.codemodule

.InsertLines .CountOfLines, _
"Const Hot_Pink As Long = 1823615" & vbNewLine & _
"global Const Hot_Pink_Index As long = 3" & vbNewLine & _
"Global Const Hot_Pink_Hex As long = &HFFFFFF"
End With

SamT
03-31-2010, 09:05 AM
Thanks,

I'll work on integrating that into the project code.

SamT
04-01-2010, 12:04 AM
Argg, look at the time

xld,

Many thanks. This is what I have so far and it works perfectly. I told you it was teaching project, but what I didn't say was that it was a learning project for me.


[Option Explicit
Sub Writing_To_Modules(Optional ByRef Constant_Strings As Variant)
' We'll be passing an Array to this Sub.

' The VBE Object contains all the VBProjects, AddIns, Windows,
' CodePanes, and CommandBars represented in Visual Basic for
' Applications.
'
' A VBProject is all the code contained in a Workbook.
' Since we may have multiple workbooks open at the same time,
' VBA needs way to tell which workbook's Project we are working
' with. The Name of a VBProjects is assigned in the properties window
'
' First, we'll make an Object Variable, "ThisProject," and set it
' to the VBProject with the Name I gave it, as there is no way to
' tell what its index number is.
Dim ThisProject As Object
Set ThisProject = Application.VBE.VBProjects("Playing_With_Color")
' VBComponents is the Collection that holds all the Modules in the
' Workbook's Project.
'
' Now, we'll make and Set an Object Variable to represent the
' "Hex_Constants" Module of this Workbook.
Dim Hex_Constants_Module As Object
Set Hex_Constants_Module = ThisProject.VBComponents("ColorHex_Constants")
' You can't write to a Module Object, You have to write to its
' associated CodeModule Object. As you read these words, you are
' Seeing the contents of the CodeModule for the Module "Manipulating_Code."
'
' Let's make and Set an Object Variable to represent the appropriate
' CodeModule
Dim Hex_CodeModule As Object
Set Hex_CodeModule = Hex_Constants_Module.CodeModule
' Of Course, you can combine all three steps above into one line.
' For the Module "Index_Constants" CodeModule;
Dim Index_CodeModule As Object
Set Index_CodeModule = Application.VBE.VBProjects("Playing_With_Color") _
.VBComponents("ColorIndex_Constants").CodeModule

'******************************************************************
' Generally, when you're doing more than one thing with the same
' Parent Object, you should use the With construct. This next bit
' of code performs exactly the same function as the code above it.
' After it runs, I'm going to erase the previously made Object
' Variables out of memory so they are no longer functioning.
' Make and Set ObjectVars to represent the Standard Modules we are
' Reading and Writing to.
Dim _
HexCode As Object, _
IndexCode As Object, _
ValueCode As Object 'Note the lack of underscore.
With Application.VBE.VBProjects("Playing_With_Color")
Set HexCode = .VBComponents("ColorHex_Constants").CodeModule
Set IndexCode = .VBComponents("ColorIndex_Constants").CodeModule
Set ValueCode = .VBComponents("ColorValue_Constants").CodeModule
End With
'*****************Clean up memory here*****************************
'
' I'll move these next bits of code out to their own procedures
' and call them from the UserForm that drives this project
'
' We'll take the ObjectVars out of memory by Setting them to Nothing.
' Note that I'm doing it in VarChild to VarParent order.
Set Hex_CodeModule = Nothing
Set Index_CodeModule = Nothing
Set Hex_Constants_Module = Nothing
Set ThisProject = Nothing
'*************Make a Collection of the R/W ObjectVars**************
'
' Up to this point in coding I have left the Procedure Declaration
' without input parameters. Now, I have added them. I'm also making
' them Optional so I don't accidently trigger an error.
' Make a new Collection object and put our three CodeModule Objects
' in it by using the ObjectVars that refer to them.
Dim ConstantModuleCollection As New Collection
With ConstantModuleCollection
.Add ValueCode
.Add IndexCode
.Add HexCode
End With
'**************Make sure the three Modules are empty**********
'
'Make an ObjectVar so we can refer to the CodeModules in our
'New Collection
Dim MyMod As Object
For Each MyMod In ConstantModuleCollection
MyMod.DeleteLines 1, MyMod.CountOfLines
'Add Option Explicit line
Next MyMod


'***********Write the Array to the CodeModules******************
'
' First, I'll need a Dummy array. Later I'll replace it with the
' inputted Array. I'll be setting up the input array as if it had
' three columns and a varible number of Rows. For testing purposes
' two Rows is enough.
Dim Dummy(2, 3) As String
Dummy(1, 1) = "Value String 1"
Dummy(2, 1) = "Value String 2"
Dummy(1, 2) = "Index String 1"
Dummy(2, 2) = "Index String 2"
Dummy(1, 3) = "Hex String 1"
Dummy(2, 3) = "Hex String 2"
Dim _
R As Long, _
C As Long
'
For C = 1 To ConstantModuleCollection.Count
For R = 1 To UBound(Dummy, 1) '1 is the Row dimension of Arrays.
'2 is for Columns
ConstantModuleCollection(C).AddFromString Dummy(R, C)

Next R
Next C

End Sub