I threw this together from some macros I created several years ago.I tested it
and cleaned it up a bit.
To insert it into your VBproject:save it to a folder.change the file extension
from ".b" to ".bas"
you should be able to double-click the file,or go into the vbeditor,
right-click in the "modules" section of the vbaproject pane and select Import
File...
Basically, I created (4)
functions:Module_ExportModule_ModifyModule_RemoveModule_Import
I think you can tell from the names what they are intended to do!You need to
edit the Module_Modify function to perform the changes you are looking for.I
have it commenting out any line with "MsgBox" in the line.
I also created two Macro subroutines.In CorrectModule_Single, you must give it
the name of the Macro Module you wish to modify.CorrectModule_All updates ALL
"standard" modules.
The macro set "assumes" that these subs and functions reside in a module called
"Mod_Admin" and therefore skips this module.
In the two subs, you'll also need to specify what folder you wish to use to
store the modules.(I used: C:\temp\VBAmodules)
Hope this gives you a starting point.
(here is the code for those that don't want to load a module from the
"interweb")
'---------------------------------------------------------------------------------Option
Explicit
'Err.Number & ": " & Err.Description
Public EventFlag
Public NewChgNum
Public VBfldr
Public fso
Public Const ForReading = 1, ForWriting = 2, ForAppending = 8
'====================================================================================================
Sub CorrectModule_Single()
Dim ModName As String
'---------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
VBfldr = "C:\temp\VBAmodules\"
If (Right(VBfldr, 1) <> "\") Then VBfldr = VBfldr & "\"
'---------------------------------
ModName = "Mod_TestData"
'---------------------------------
If (Not Module_Export(ModName)) Then Exit Sub
If (Not Module_Modify(ModName)) Then Exit Sub
If (Not Module_Remove(ModName)) Then Exit Sub
If (Not Module_Import(ModName)) Then Exit Sub
MsgBox "Finished"
End Sub
'====================================================================================================
Sub CorrectModule_All()
Dim VBAmodule 'As VBProject.VBComponents
Dim VBComp
Dim ModName As String
'---------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
VBfldr = "C:\temp\VBAmodules\"
If (Right(VBfldr, 1) <> "\") Then VBfldr = VBfldr & "\"
'---------------------------------
Set VBAmodule = ThisWorkbook.VBProject.VBComponents
Application.StatusBar = "Processing all Modules..."
For Each VBComp In VBAmodule
If VBComp.Type = 1 Then
If (UCase(VBComp.Name) <> UCase("Mod_Admin")) Then
ModName = VBComp.Name
If (Not Module_Export(ModName)) Then Exit Sub
If (Not Module_Modify(ModName)) Then Exit Sub
If (Not Module_Remove(ModName)) Then Exit Sub
If (Not Module_Import(ModName)) Then Exit Sub
End If
End If
Next VBComp
Application.StatusBar = False
MsgBox "Finished"
End
Sub'====================================================================================================
Function Module_Modify(ModName)
Dim f, fs, ft, fw
Dim inString
Module_Modify = False
'----------------------------------------------------------------------
If (Not fso.folderexists(VBfldr)) Then
MsgBox "Folder not found:" & Chr(13) & VBfldr
Exit Function
End If
If (Not fso.fileexists(VBfldr & ModName & ".bas")) Then
MsgBox "File not found:" & Chr(13) & ModName & ".bas" & Chr(13) & "in
folder:" & Chr(13) & VBfldr
Exit Function
End If
'----------------------------------------------------------------------
Set fw = fso.OpenTextFile(VBfldr & ModName & ".txt", ForWriting,
True)
If (Err.Number <> 0) Then
MsgBox "Could not open " & VBfldr & ModName & ".txt"
Exit Function
End If
'--------------------------------------------------------------------
Set ft = fso.OpenTextFile(VBfldr & ModName & ".bas", ForReading)
If (Err.Number <> 0) Then
MsgBox "Could not open " & VBfldr & ModName & ".bas"
Exit Function
End If
'--------------------------------------------------------------------
Do While Not ft.atendofstream
inString = ft.readline
'--------------------------------------------------------------------
' in this section, use string functions to locate the lines you
wish
' to comment out.
' You can comment the entire line (by putting a tick at the
beginning)
' or comment out a portion or even replace or remove entire
lines.
'--------------------------------------------------------------------
' Note: I like to force the string to uppercase to avoid
mismatched words
'--------------------------------------------------------------------
If (InStr(1, UCase(inString), UCase("msgbox")) > 0) Then
fw.WriteLine "'" & inString
Else
fw.WriteLine inString
End If
Loop
ft.Close
fw.Close
'--------------------------------------------------------------------
If ((fso.fileexists(VBfldr & ModName & ".bas")) _
And (fso.fileexists(VBfldr & ModName & ".txt"))) Then
fso.deletefile VBfldr & ModName & ".bas", True
fso.copyfile VBfldr & ModName & ".txt", VBfldr & ModName &
".bas"
If (fso.fileexists(VBfldr & ModName & ".bas")) Then
fso.deletefile VBfldr & ModName & ".txt", True
Else
MsgBox "Failed to copy Module:" & Chr(13) & ModName & ".txt"
Exit Function
End If
Else
MsgBox "Failed to modify Module:" & Chr(13) & ModName
Exit Function
End If
'--------------------------------------------------------------------
Module_Modify = True
End Function
Function Module_Export(ModName)
Dim VBAmodule
Dim VBComp
Module_Export = False
Set VBAmodule = ThisWorkbook.VBProject.VBComponents On Error Resume Next
Err.Clear
If (Not fso.folderexists(VBfldr)) Then
fso.createfolder (VBfldr)
End If
If (Err.Number <> 0) Then
MsgBox "Unable to create folder:" & Chr(13) & VBfldr
Exit Function
End If
For Each VBComp In VBAmodule
If VBComp.Type = 1 Then
If (UCase(VBComp.Name) = UCase(ModName)) Then
ThisWorkbook.VBProject.VBComponents(VBComp.Name).Export (VBfldr
& VBComp.Name & ".bas")
Exit For
' VBAmodule.Remove VBComp
End If
End If
Next VBComp
Module_Export = True
End Function
'====================================================================================================
Function Module_Remove(ModName)
Dim VBAmodule
Dim VBComp
Module_Remove = False
Set VBAmodule = ThisWorkbook.VBProject.VBComponents
On Error Resume Next
Err.Clear
For Each VBComp In VBAmodule
If VBComp.Type = 1 Then
If (UCase(VBComp.Name) = UCase(ModName)) Then VBAmodule.Remove
VBComp
If (Err.Number <> 0) Then
MsgBox "Error encountered removing modules"
Exit Function
End If
End If
Next VBComp
Module_Remove = True
End Function
'====================================================================================================Function
Module_Import(ModName)
Dim VBAmodule
Module_Import = False
'----------------------------------------------------------------------
If (Not fso.folderexists(VBfldr)) Then
MsgBox "Folder not found:" & Chr(13) & VBfldr
Exit Function
End If
If (Not fso.fileexists(VBfldr & ModName & ".bas")) Then
MsgBox "File not found:" & Chr(13) & ModName & ".bas" & Chr(13) & "in
folder:" & Chr(13) & VBfldr
Exit Function
End If
'----------------------------------------------------------------------
Set VBAmodule = ThisWorkbook.VBProject.VBComponents
ThisWorkbook.VBProject.VBComponents.Import Filename:=VBfldr & ModName &
".bas"
If (Err.Number <> 0) Then
MsgBox "Error importing module:" & Chr(13) & ModName & ".bas"
Exit Function
End If
Module_Import = True
End Function
'====================================================================================================
Paul-----------------------------------------
“Do all the good you can,
By all the means you can,
In all the ways you can,
In all the places you can,
At all the times you can,
To all the people you can,
As long as ever you can.” - John Wesley
-----------------------------------------
On Thursday, February 4, 2016 4:07 AM, XL Macros <xlsm.mac...@gmail.com>
wrote:
Thank you Paul for quick reply,
Your understanding of my requirement is correct. For easy understand of the
requirement i said msgbox code need to be comment out, where as in my actual
macro their are couple of macro lines to be comment out. If you tell me the way
to comment one line of code, i can do it for other lines.
Your help in this regard highly appreciated
Regards,Karthik
On Wed, Feb 3, 2016 at 6:13 PM, Paul Schreiner <schreiner_p...@att.net> wrote:
I take it you are trying to say that you want to "comment out" the Msgbox line?
One solution would be to:Export the macro moduleUse Textstream Object to edit
the exported ascii file.Remove the macro moduleImport the edited module.
Now, this would only work on "standard" modules.Because I don't think you can
remove the sheet modules without removing the sheet!
If you want to try this approach, let me know and I'll search through my macros
and find the tools you need.
Paul-----------------------------------------
“Do all the good you can,
By all the means you can,
In all the ways you can,
In all the places you can,
At all the times you can,
To all the people you can,
As long as ever you can.” - John Wesley
-----------------------------------------
On Wednesday, February 3, 2016 3:58 AM, XL Macros <xlsm.mac...@gmail.com>
wrote:
Hi All,
Can we comment few line of code in existing macros using macros ?
For more clarity on my question, i'm giving below macro code
Sub selectshapes()Dim shp As Shape
For Each shp In ActiveSheet.Shapes
ActiveSheet.Shapes(shp.name).Select Selection.Delete Next shp
'I want to comment below line of code using macros MsgBox "All objectes
deleted successfully"
End Sub
In the above code i want to comment last 2nd line, i.e Msgbox... i want to
comment with macros not manually
Please suggest on this requirement. Thanks in advance
Regards,Karthik--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
Attribute VB_Name = "Mod_Admin"
Option Explicit
'Err.Number & ": " & Err.Description
Public EventFlag
Public NewChgNum
Public VBfldr
Public fso
Public Const ForReading = 1, ForWriting = 2, ForAppending = 8
'====================================================================================================
Sub CorrectModule_Single()
Dim ModName As String
'---------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
VBfldr = "C:\temp\VBAmodules\"
If (Right(VBfldr, 1) <> "\") Then VBfldr = VBfldr & "\"
'---------------------------------
ModName = "Mod_TestData"
'---------------------------------
If (Not Module_Export(ModName)) Then Exit Sub
If (Not Module_Modify(ModName)) Then Exit Sub
If (Not Module_Remove(ModName)) Then Exit Sub
If (Not Module_Import(ModName)) Then Exit Sub
MsgBox "Finished"
End Sub
'====================================================================================================
Sub CorrectModule_All()
Dim VBAmodule 'As VBProject.VBComponents
Dim VBComp
Dim ModName As String
'---------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
VBfldr = "C:\temp\VBAmodules\"
If (Right(VBfldr, 1) <> "\") Then VBfldr = VBfldr & "\"
'---------------------------------
Set VBAmodule = ThisWorkbook.VBProject.VBComponents
Application.StatusBar = "Processing all Modules..."
For Each VBComp In VBAmodule
If VBComp.Type = 1 Then
If (UCase(VBComp.Name) <> UCase("Mod_Admin")) Then
ModName = VBComp.Name
If (Not Module_Export(ModName)) Then Exit Sub
If (Not Module_Modify(ModName)) Then Exit Sub
If (Not Module_Remove(ModName)) Then Exit Sub
If (Not Module_Import(ModName)) Then Exit Sub
End If
End If
Next VBComp
Application.StatusBar = False
MsgBox "Finished"
End Sub
'====================================================================================================
Function Module_Modify(ModName)
Dim f, fs, ft, fw
Dim inString
Module_Modify = False
'----------------------------------------------------------------------
If (Not fso.folderexists(VBfldr)) Then
MsgBox "Folder not found:" & Chr(13) & VBfldr
Exit Function
End If
If (Not fso.fileexists(VBfldr & ModName & ".bas")) Then
MsgBox "File not found:" & Chr(13) & ModName & ".bas" & Chr(13) & "in
folder:" & Chr(13) & VBfldr
Exit Function
End If
'----------------------------------------------------------------------
Set fw = fso.OpenTextFile(VBfldr & ModName & ".txt", ForWriting,
True)
If (Err.Number <> 0) Then
MsgBox "Could not open " & VBfldr & ModName & ".txt"
Exit Function
End If
'--------------------------------------------------------------------
Set ft = fso.OpenTextFile(VBfldr & ModName & ".bas", ForReading)
If (Err.Number <> 0) Then
MsgBox "Could not open " & VBfldr & ModName & ".bas"
Exit Function
End If
'--------------------------------------------------------------------
Do While Not ft.atendofstream
inString = ft.readline
'--------------------------------------------------------------------
' in this section, use string functions to locate the lines you
wish
' to comment out.
' You can comment the entire line (by putting a tick at the
beginning)
' or comment out a portion or even replace or remove entire
lines.
'--------------------------------------------------------------------
' Note: I like to force the string to uppercase to avoid
mismatched words
'--------------------------------------------------------------------
If (InStr(1, UCase(inString), UCase("msgbox")) > 0) Then
fw.WriteLine "'" & inString
Else
fw.WriteLine inString
End If
Loop
ft.Close
fw.Close
'--------------------------------------------------------------------
If ((fso.fileexists(VBfldr & ModName & ".bas")) _
And (fso.fileexists(VBfldr & ModName & ".txt"))) Then
fso.deletefile VBfldr & ModName & ".bas", True
fso.copyfile VBfldr & ModName & ".txt", VBfldr & ModName &
".bas"
If (fso.fileexists(VBfldr & ModName & ".bas")) Then
fso.deletefile VBfldr & ModName & ".txt", True
Else
MsgBox "Failed to copy Module:" & Chr(13) & ModName & ".txt"
Exit Function
End If
Else
MsgBox "Failed to modify Module:" & Chr(13) & ModName
Exit Function
End If
'--------------------------------------------------------------------
Module_Modify = True
End Function
Function Module_Export(ModName)
Dim VBAmodule
Dim VBComp
Module_Export = False
Set VBAmodule = ThisWorkbook.VBProject.VBComponents
On Error Resume Next
Err.Clear
If (Not fso.folderexists(VBfldr)) Then
fso.createfolder (VBfldr)
End If
If (Err.Number <> 0) Then
MsgBox "Unable to create folder:" & Chr(13) & VBfldr
Exit Function
End If
For Each VBComp In VBAmodule
If VBComp.Type = 1 Then
If (UCase(VBComp.Name) = UCase(ModName)) Then
ThisWorkbook.VBProject.VBComponents(VBComp.Name).Export (VBfldr
& VBComp.Name & ".bas")
Exit For
' VBAmodule.Remove VBComp
End If
End If
Next VBComp
Module_Export = True
End Function
'====================================================================================================
Function Module_Remove(ModName)
Dim VBAmodule
Dim VBComp
Module_Remove = False
Set VBAmodule = ThisWorkbook.VBProject.VBComponents
On Error Resume Next
Err.Clear
For Each VBComp In VBAmodule
If VBComp.Type = 1 Then
If (UCase(VBComp.Name) = UCase(ModName)) Then VBAmodule.Remove
VBComp
If (Err.Number <> 0) Then
MsgBox "Error encountered removing modules"
Exit Function
End If
End If
Next VBComp
Module_Remove = True
End Function
'====================================================================================================
Function Module_Import(ModName)
Dim VBAmodule
Module_Import = False
'----------------------------------------------------------------------
If (Not fso.folderexists(VBfldr)) Then
MsgBox "Folder not found:" & Chr(13) & VBfldr
Exit Function
End If
If (Not fso.fileexists(VBfldr & ModName & ".bas")) Then
MsgBox "File not found:" & Chr(13) & ModName & ".bas" & Chr(13) & "in
folder:" & Chr(13) & VBfldr
Exit Function
End If
'----------------------------------------------------------------------
Set VBAmodule = ThisWorkbook.VBProject.VBComponents
ThisWorkbook.VBProject.VBComponents.Import Filename:=VBfldr & ModName &
".bas"
If (Err.Number <> 0) Then
MsgBox "Error importing module:" & Chr(13) & ModName & ".bas"
Exit Function
End If
Module_Import = True
End Function
'====================================================================================================
