Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Code Colors
Is there a way to change the color of a couple of lines of code. Each year I
have to search through a lot of code to modify specific lines. I was wondering if there is a way to change s line or two of code to a different color (say red), so next year I can scroll through the code and look for the red lines? I've looked at the options in the VB Editor but couldn't find a way to change a line and keep it that color when I re-open the Editor. Thanks for the help.....Mike -- JT |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Code Colors
You can't change the color of specific lines of code in the editor. You
could mark with comments the code that needs to be changed and search for those comments when you need to change the code. Better yet, of course, would be to properly write the code such that it doesn't need to be changed from one year to the next. -- Cordially, Chip Pearson Microsoft MVP - Excel, 10 Years Pearson Software Consulting www.cpearson.com (email on the web site) "JT" wrote in message ... Is there a way to change the color of a couple of lines of code. Each year I have to search through a lot of code to modify specific lines. I was wondering if there is a way to change s line or two of code to a different color (say red), so next year I can scroll through the code and look for the red lines? I've looked at the options in the VB Editor but couldn't find a way to change a line and keep it that color when I re-open the Editor. Thanks for the help.....Mike -- JT |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Code Colors
On Nov 15, 10:48 am, JT wrote:
Is there a way to change the color of a couple of lines of code. Each year I have to search through a lot of code to modify specific lines. I was wondering if there is a way to change s line or two of code to a different color (say red), so next year I can scroll through the code and look for the red lines? I've looked at the options in the VB Editor but couldn't find a way to change a line and keep it that color when I re-open the Editor. Thanks for the help.....Mike -- JT I can't say if this is proper coding but normal I'll box in parts so I can easily find them. ie '================================================= === write code in here '================================================= === |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Code Colors
this isn't a free solution, maybe something like this would help. you could
print to a pdf and use it for a reference http://www.starprint2000.com/product_vbacodeprint.aspx http://submain.com/?nav=products.pcp Color Schemes a.. Quick way to switch the colors for syntax highlighting, you can choose predefined b.. Default scheme for color printer c.. Scheme for B&W printer d.. Standard VB IDE colors e.. You can even import your current color scheme from VB IDE -- Gary "JT" wrote in message ... Is there a way to change the color of a couple of lines of code. Each year I have to search through a lot of code to modify specific lines. I was wondering if there is a way to change s line or two of code to a different color (say red), so next year I can scroll through the code and look for the red lines? I've looked at the options in the VB Editor but couldn't find a way to change a line and keep it that color when I re-open the Editor. Thanks for the help.....Mike -- JT |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Code Colors
Another, trivial way is to convert the code, module by module, into the text
file, where it can be deliberately colored. It may be also a proper backup, because it is again retransportable by parts back in the modules. -- Petr Bezucha "Gary Keramidas" wrote: this isn't a free solution, maybe something like this would help. you could print to a pdf and use it for a reference http://www.starprint2000.com/product_vbacodeprint.aspx http://submain.com/?nav=products.pcp Color Schemes a.. Quick way to switch the colors for syntax highlighting, you can choose predefined b.. Default scheme for color printer c.. Scheme for B&W printer d.. Standard VB IDE colors e.. You can even import your current color scheme from VB IDE -- Gary "JT" wrote in message ... Is there a way to change the color of a couple of lines of code. Each year I have to search through a lot of code to modify specific lines. I was wondering if there is a way to change s line or two of code to a different color (say red), so next year I can scroll through the code and look for the red lines? I've looked at the options in the VB Editor but couldn't find a way to change a line and keep it that color when I re-open the Editor. Thanks for the help.....Mike -- JT |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Code Colors
I totally agree with Chip.
Somehow your code has some problems if you have to change it every year. As a workaround, you could also put the values you need to change in a sheet, protect it with a password and hide it, and then refer to that sheet in your code. If you want to keep it in your code do something like that: 'UpdateCodeHere--------------------------------------------------------------------------------------------- which is followed by your code. then you can press ctrl+f and search the whole project (checkbox) for "UpdateCode". hth Carlo |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Code Colors
On Nov 16, 8:24 am, carlo wrote:
I totally agree with Chip. Somehow yourcodehas some problems if you have to change it every year. As a workaround, you could also put the values you need to change in a sheet, protect it with a password and hide it, and then refer to that sheet in yourcode. If you want to keep it in yourcodedo something like that: 'UpdateCodeHere--------------------------------------------------------------------------------------------- which is followed by yourcode. then you can press ctrl+f and search the whole project (checkbox) for "UpdateCode". hth Carlo Have thought of using a Script Control (msscript.ocx) or similar to replace this altering logic with a piece of static code with calls your own customised scripts? I find it very handy for using with financial formulas which can change each year. Regards, Kev K |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Code Colors
If this doesn't cover it, then I made my a code formatting user
control for viewing VBScript, though it can be easily changed to suit your needs. You just need to create a new user control with a Rich Text Box on it (called txtScriptContents), then use the following code. Note, CUSTOM_KEYWORDS is specific to my code, but can be replaced with the keywords that you require. Cheers, Kev K '--------------------------------------------------------------------------------------- ' Module : ucCodeText ' DateTime : 28 May 2005 ' Author : Kevin Kitchen ' Purpose : Contains the functionality for displaying formatted code ' ' This code is free to copy and use, but if using this code, please do not remove the ' author comments as this is my intellectual property ' ' If you are fixing bugs in this code and feeling charitable please also send the changes ' to me at: ' kevkitchen AT G MAIL DOT COM (changed to avoid address harvesters, but you get the drift) '--------------------------------------------------------------------------------------- Private Const MODULE_NAME = "ucCodeText" Option Explicit Private m_bFormatScriptOnChange As Boolean Private Const VBS_KEYWORDS = ":addhandler:addressof:andalso:alias:and:ansi:as:a ssembly:attribute:auto:" & _ "begin:boolean:byref:byte:byval:call:case:catch:cb ool:cbyte:cchar:cdate:" & _ "cdec:cdbl:char:cint:class:clng:cobj:compaconst :continue:cshort:csng:" & _ "cstr:ctype:currency:date:decimal:decladefault: delegate:dim:do:double:" & _ "each:else:elseif:end:enum:erase:error:event:exit: explicit:false:finally:" & _ "for:friend:function:get:gettype:global:gosub:goto :handles:if:implement:" & _ "implements:imports:in:inherits:integer:interface: is:let:lib:like:load:" & _ "long:loop:lset:me:mid:mod:module:mustinherit:must override:mybase:myclass:" & _ "namespace:new:next:not:nothing:notinheritable:not overridable:object:on:" & _ "option:optional:or:orelse:overloads:overridable:o verrides:paramarray:" & _ "preserve:private:property:protected:public:raisee vent:readonly:redim:rem:" & _ "removehandler:rset:resume:return:select:set:shado ws:shared:short:single:" & _ "static:step:stop:string:structusub:synclock:th en:throw:to:true:try:" & _ "type:typeof:unload:unicode:until:variant:wend:whe n:while:with:withevents:" & _ "writeonly:" Private Const CUSTOM_KEYWORDS = ":ScriptStart:Sleep:ExitNumber:LastExitNumber:Quit :" & _ "NTUserName:LogDebugMessage:KillProcess:Shell:AppA ctivate:" ' Comment (Green), Keyword (Blue), String (Teal), Custom Keyword (Reddish-Brown) Private Const RTF_COLOUR_TABLE = "{\colortbl;" & _ "\red0\green128\blue0;" & _ "\red0\green0\blue255;" & _ "\red0\green128\blue128;" & _ "\red128\green64\blue0;}" Private Const RTF_FONT_TABLE = "{\fonttbl{\f0\fnil\fcharset0 Courier New;}" 'Event Declarations: Event Click() 'MappingInfo=txtScriptContents,txtScriptContents,-1,Click Event DblClick() 'MappingInfo=txtScriptContents,txtScriptContents,-1,DblClick Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=txtScriptContents,txtScriptContents,-1,KeyDown Event KeyPress(KeyAscii As Integer) 'MappingInfo=txtScriptContents,txtScriptContents,-1,KeyPress Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=txtScriptContents,txtScriptContents,-1,KeyUp Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=txtScriptContents,txtScriptContents,-1,MouseDown Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=txtScriptContents,txtScriptContents,-1,MouseMove Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=txtScriptContents,txtScriptContents,-1,MouseUp Event Change() 'MappingInfo=txtScriptContents,txtScriptContents,-1,Change Event SelChange() 'MappingInfo=txtScriptContents,txtScriptContents,-1,SelChange Event Validate(Cancel As Boolean) 'MappingInfo=txtScriptContents,txtScriptContents,-1,Validate Private Sub UserControl_GotFocus() Call txtScriptContents.SetFocus End Sub Private Sub UserControl_Initialize() txtScriptContents.Move 0, 0, UserControl.Width, UserControl.Height End Sub '--------------------------------------------------------------------------------------- ' Procedure : txtScriptContents_Change ' DateTime : 26 May 2007 ' Author : Kevin Kitchen ' Purpose : '--------------------------------------------------------------------------------------- Private Sub txtScriptContents_Change() On Error GoTo ErrorHandler Const PROCEDURE_NAME = "txtScriptContents_Change" Dim lPostition As Long If m_bFormatScriptOnChange Then lPostition = txtScriptContents.SelStart FormatScript txtScriptContents.SelStart = lPostition m_bFormatScriptOnChange = False End If RaiseEvent Change Exit Sub ErrorHandler: End Sub '--------------------------------------------------------------------------------------- ' Procedure : txtScriptContents_KeyDown ' DateTime : 26 May 2007 ' Author : Kevin Kitchen ' Purpose : '--------------------------------------------------------------------------------------- Private Sub txtScriptContents_KeyDown(KeyCode As Integer, Shift As Integer) On Error GoTo ErrorHandler Const PROCEDURE_NAME = "txtScriptContents_KeyDown" Select Case KeyCode Case 96 To 105 ' Numeric Keypad m_bFormatScriptOnChange = False Case 48 To 57 ' Normal numbers If Shift = 0 Then ' No shift alteration m_bFormatScriptOnChange = True Else m_bFormatScriptOnChange = False End If Case 65 To 90 ' Alpha keys m_bFormatScriptOnChange = True Case Else m_bFormatScriptOnChange = False End Select RaiseEvent KeyDown(KeyCode, Shift) Exit Sub ErrorHandler: End Sub Private Sub txtScriptContents_Validate(Cancel As Boolean) Call FormatScript RaiseEvent Validate(Cancel) End Sub Private Sub UserControl_Resize() txtScriptContents.Move 0, 0, UserControl.Width, UserControl.Height End Sub 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,BackColor Public Property Get BackColor() As OLE_COLOR BackColor = txtScriptContents.BackColor End Property Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR) txtScriptContents.BackColor() = New_BackColor PropertyChanged "BackColor" End Property 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,Enabled Public Property Get Enabled() As Boolean Enabled = txtScriptContents.Enabled End Property Public Property Let Enabled(ByVal New_Enabled As Boolean) txtScriptContents.Enabled() = New_Enabled PropertyChanged "Enabled" End Property 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,Font Public Property Get Font() As Font Set Font = txtScriptContents.Font End Property Public Property Set Font(ByVal New_Font As Font) Set txtScriptContents.Font = New_Font PropertyChanged "Font" End Property 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,Refresh Public Sub Refresh() txtScriptContents.Refresh End Sub Private Sub txtScriptContents_Click() RaiseEvent Click End Sub Private Sub txtScriptContents_DblClick() RaiseEvent DblClick End Sub Private Sub txtScriptContents_KeyPress(KeyAscii As Integer) RaiseEvent KeyPress(KeyAscii) End Sub Private Sub txtScriptContents_KeyUp(KeyCode As Integer, Shift As Integer) RaiseEvent KeyUp(KeyCode, Shift) End Sub 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,Locked Public Property Get Locked() As Boolean Locked = txtScriptContents.Locked End Property Public Property Let Locked(ByVal New_Locked As Boolean) txtScriptContents.Locked() = New_Locked PropertyChanged "Locked" End Property 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,MaxLength Public Property Get MaxLength() As Long MaxLength = txtScriptContents.MaxLength End Property Public Property Let MaxLength(ByVal New_MaxLength As Long) txtScriptContents.MaxLength() = New_MaxLength PropertyChanged "MaxLength" End Property 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,MouseIcon Public Property Get MouseIcon() As Picture Set MouseIcon = txtScriptContents.MouseIcon End Property Public Property Set MouseIcon(ByVal New_MouseIcon As Picture) Set txtScriptContents.MouseIcon = New_MouseIcon PropertyChanged "MouseIcon" End Property 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,MousePointer Public Property Get MousePointer() As MousePointerConstants MousePointer = txtScriptContents.MousePointer End Property Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants) txtScriptContents.MousePointer() = New_MousePointer PropertyChanged "MousePointer" End Property Private Sub txtScriptContents_SelChange() RaiseEvent SelChange End Sub 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,SelPrint Public Sub SelPrint(ByVal lHDC As Long, Optional ByVal vStartDoc As Variant) txtScriptContents.SelPrint lHDC, vStartDoc End Sub 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,Text Public Property Get Text() As String Text = txtScriptContents.Text End Property Public Property Let Text(ByVal New_Text As String) m_bFormatScriptOnChange = True txtScriptContents.Text() = New_Text PropertyChanged "Text" End Property 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtScriptContents,txtScriptContents,-1,ToolTipText Public Property Get ToolTipText() As String ToolTipText = txtScriptContents.ToolTipText End Property Public Property Let ToolTipText(ByVal New_ToolTipText As String) txtScriptContents.ToolTipText() = New_ToolTipText PropertyChanged "ToolTipText" End Property 'Load property values from storage Private Sub UserControl_ReadProperties(PropBag As PropertyBag) txtScriptContents.BackColor = PropBag.ReadProperty("BackColor", &H80000005) txtScriptContents.Enabled = PropBag.ReadProperty("Enabled", True) Set txtScriptContents.Font = PropBag.ReadProperty("Font", Ambient.Font) txtScriptContents.HideSelection = PropBag.ReadProperty("HideSelection", True) txtScriptContents.Locked = PropBag.ReadProperty("Locked", False) txtScriptContents.MaxLength = PropBag.ReadProperty("MaxLength", 0) Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing) txtScriptContents.MousePointer = PropBag.ReadProperty("MousePointer", 0) txtScriptContents.Text = PropBag.ReadProperty("Text", "txtCode") txtScriptContents.ToolTipText = PropBag.ReadProperty("ToolTipText", "") End Sub 'Write property values to storage Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("BackColor", txtScriptContents.BackColor, &H80000005) Call PropBag.WriteProperty("Enabled", txtScriptContents.Enabled, True) Call PropBag.WriteProperty("Font", txtScriptContents.Font, Ambient.Font) Call PropBag.WriteProperty("HideSelection", txtScriptContents.HideSelection, True) Call PropBag.WriteProperty("Locked", txtScriptContents.Locked, False) Call PropBag.WriteProperty("MaxLength", txtScriptContents.MaxLength, 0) Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing) Call PropBag.WriteProperty("MousePointer", txtScriptContents.MousePointer, 0) Call PropBag.WriteProperty("Text", txtScriptContents.Text, "txtCode") Call PropBag.WriteProperty("ToolTipText", txtScriptContents.ToolTipText, "") End Sub '--------------------------------------------------------------------------------------- ' Procedure : FormatScript ' DateTime : 26 May 2007 ' Author : Kevin Kitchen ' Purpose : Formats the current script contents '--------------------------------------------------------------------------------------- Private Sub FormatScript() On Error GoTo ErrorHandler Const PROCEDURE_NAME = "FormatScript" Dim sScript As String Dim sLines() As String Dim lLineIndex As Long Dim sNewScript As String Dim sScriptLine As String txtScriptContents.Text = vbNewLine & txtScriptContents.Text ' Should also remove formatting sScript = Replace(txtScriptContents.TextRTF, Chr$(10), Chr$(13)) sScript = Replace(sScript, Chr$(13) & Chr$(13), Chr$(13)) sLines = Split(sScript, Chr$(13)) For lLineIndex = LBound(sLines) To UBound(sLines) If (Left$(sLines(lLineIndex), 4) = "\par") Then sScriptLine = Right$(sLines(lLineIndex), Len(sLines(lLineIndex)) - 5) sNewScript = sNewScript & FormatLine(sScriptLine) & _ "\par " End If Next lLineIndex sNewScript = "{\rtf1\ansi\deff0" & RTF_COLOUR_TABLE & RTF_FONT_TABLE & "}" & vbNewLine & _ "\viewkind4\uc1\pard\lang6153\f0\fs17 " & sNewScript txtScriptContents.TextRTF = sNewScript Exit Sub ErrorHandler: End Sub '--------------------------------------------------------------------------------------- ' Procedure : FormatLine ' DateTime : 26 May 2007 ' Author : Kevin Kitchen ' Purpose : Formats a VBScript line and adds formatting '--------------------------------------------------------------------------------------- Private Function FormatLine(ByVal p_sScriptLine As String) As String Dim bInComment As Boolean Dim bInString As Boolean Dim bInWord As Boolean Dim lSectionStart As Long Dim lLineIndex As Long Dim sNewLine As String Dim sCurrentChar As String * 1 Dim lSectionLength As Long Dim sSectionContents As String Dim sScriptLineLeft As String Dim sScriptLineRight As String On Error GoTo ErrorHandler Const PROCEDURE_NAME = "FormatLine" p_sScriptLine = p_sScriptLine & " " For lLineIndex = 1 To Len(p_sScriptLine) sCurrentChar = Mid$(p_sScriptLine, lLineIndex, 1) Select Case sCurrentChar Case "'" If bInWord Then lSectionLength = lLineIndex - lSectionStart bInWord = False sSectionContents = Mid$(p_sScriptLine, lSectionStart, lSectionLength) sNewLine = sNewLine & FormatWord(sSectionContents) End If If Not bInString Then bInComment = True lSectionLength = Len(p_sScriptLine) - lLineIndex sSectionContents = RTrim$(Mid$(p_sScriptLine, lLineIndex, lSectionLength)) sNewLine = sNewLine & "{\cf1 " & sSectionContents & "}" Exit For End If Case """" If bInString Then bInString = False lSectionLength = lLineIndex - lSectionStart sSectionContents = Mid$(p_sScriptLine, lSectionStart, lSectionLength + 1) sNewLine = sNewLine & "{\cf3 " & sSectionContents & "}" Else If bInWord Then lSectionLength = lLineIndex - lSectionStart bInWord = False sSectionContents = Mid$(p_sScriptLine, lSectionStart, lSectionLength) sNewLine = sNewLine & FormatWord(sSectionContents) End If bInString = True lSectionStart = lLineIndex End If Case "a" To "z", "A" To "Z", "0" To "9" If Not (bInWord Or bInComment Or bInString) Then bInWord = True lSectionStart = lLineIndex End If Case Else If Not bInString Then If bInWord Then lSectionLength = lLineIndex - lSectionStart bInWord = False sSectionContents = Mid$(p_sScriptLine, lSectionStart, lSectionLength) sNewLine = sNewLine & FormatWord(sSectionContents) End If sNewLine = sNewLine & sCurrentChar lSectionStart = lLineIndex End If End Select Next lLineIndex If bInString Then ' We are in an unclosed string, so close it bInString = False lSectionLength = Len(p_sScriptLine) - lSectionStart sSectionContents = Trim$(Mid$(p_sScriptLine, lSectionStart, lSectionLength + 1)) sNewLine = sNewLine & "{\cf3 " & sSectionContents & "}" End If FormatLine = RTrim$(sNewLine) Exit Function ErrorHandler: End Function '--------------------------------------------------------------------------------------- ' Procedure : FormatWord ' DateTime : 26 May 2007 ' Author : Kevin Kitchen ' Purpose : Formats control words '--------------------------------------------------------------------------------------- Private Function FormatWord(ByVal p_sWord As String) As String On Error GoTo ErrorHandler Const PROCEDURE_NAME = "FormatWord" Dim sFormattedWord As String Dim sWordSearch As String sWordSearch = ":" & p_sWord & ":" If InStr(1, VBS_KEYWORDS, sWordSearch, vbTextCompare) 0 Then sFormattedWord = "{\cf2 " & p_sWord & "}" ElseIf InStr(1, CUSTOM_KEYWORDS, sWordSearch, vbTextCompare) 0 Then sFormattedWord = "{\cf4 " & p_sWord & "}" Else sFormattedWord = p_sWord End If FormatWord = sFormattedWord Exit Function ErrorHandler: End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Used drawing colors in shapes....lost default colors for "Fill Col | Excel Discussion (Misc queries) | |||
Worksheet formatting (fill colors & text colors) disappeared | Excel Discussion (Misc queries) | |||
Print VBA code in Editor format colors | Excel Programming | |||
VBA code to count colors/shapes? | Excel Programming | |||
how can i select all the cells with same color on a sheet if there are multipale colors by vba code | Charts and Charting in Excel |