Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
プロシージャ自身の名前を示すPROC_NAME定数を更新する
Option Explicit
'vbeProcedureオブジェクトを作成してそれらのコレクションを返す
'モジュール中のコードを解析し、モジュール内のプロシージャ情報をリストアップする
Private Function getProcedures(codeMod As CodeModule) As Collection
Dim StartLine As Long
Dim ProcName As String
Dim lastProcName As String
Dim lastProcKind As vbext_ProcKind
Dim procs As New Collection
Dim proc As vbeProcedure
Dim ProcKind As vbext_ProcKind
Dim i As Long
' Option句の行の省略
StartLine = codeMod.CountOfDeclarationLines + 1
'各プロシージャの最初行でオブジェクトを作成しコレクションに追加
For i = StartLine To codeMod.CountOfLines
ProcName = codeMod.ProcOfLine(i, ProcKind)
If ProcName <> lastProcName Or ProcKind <> lastProcKind Then
Set proc = New vbeProcedure
proc.initialize ProcName, codeMod, ProcKind
procs.Add proc
lastProcName = ProcName
lastProcKind = ProcKind
End If
Next
Set getProcedures = procs
End Function
'Const PROC_NAME = "プロシージャ名"を更新する。
Private Sub fixProcNameConstants(codeMod As CodeModule)
Dim procs As Collection
Dim proc As vbeProcedure
Dim i As Long
'プロシージャ情報を管理するオブジェクトコレクションを取得
Set procs = getProcedures(codeMod)
Debug.Print
For Each proc In procs
With proc
Debug.Print .ProcKind, .StartLine, .CountOfLines, .EndLine, .ParentModule, .Name
For i = .StartLine + 1 To .EndLine
If InStr(1, .ParentModule.Lines(i, 1), "Const PROC_NAME", vbTextCompare) Then
' Debug.Print .ParentModule.Lines(i, 1)
.ParentModule.ReplaceLine i, "Const PROC_NAME As String = " & Chr(34) & .Name & Chr(34)
' Debug.Print .ParentModule.Lines(i, 1)
Exit For
End If
Next
End With
Next
End Sub
'全てのPROC_NAMEを更新する
'・モジュール中に「Const PROC_NAME = ""」の記載がある時、
' ダブルクォーテーション内のプロシージャ名を現時点の名前に更新する
'・ただしDevUtilitiesモジュールは除く
Public Sub FixAllProcNameConstants()
Dim prj As VBProject
Set prj = Application.VBE.ActiveVBProject
Dim codeMod As CodeModule
Dim vbComp As VBComponent
For Each vbComp In prj.VBComponents
Set codeMod = vbComp.CodeModule
If Not codeMod.Name = "DevUtilities" Then
fixProcNameConstants codeMod
End If
Next
End Sub
' Class: vbeProcedure
' requires Microsoft Visual Basic for Applications Extensibility 5.3 library
' Author: Christopher J. McClellan
' Creative Commons Share Alike and Attribute license
' http://creativecommons.org/licenses/by-sa/3.0/
Option Explicit
Private Const vbeProcedureError As Long = 3500
Private mParentModule As CodeModule
Private isParentModSet As Boolean
Private mName As String
Private isNameSet As Boolean
Private mProcKind As vbext_ProcKind
Private isProcKindSet As Boolean
Public Property Get Name() As String
If isNameSet Then
Name = mName
Else
RaiseObjectNotIntializedError
End If
End Property
Public Property Let Name(ByVal vNewValue As String)
If Not isNameSet Then
mName = vNewValue
isNameSet = True
Else
RaiseReadOnlyPropertyError
End If
End Property
Public Property Get ProcKind() As String
If isProcKindSet Then
ProcKind = mProcKind
Else
RaiseObjectNotIntializedError
End If
End Property
Public Property Let ProcKind(ByVal vNewValue As String)
If Not isProcKindSet Then
mProcKind = vNewValue
isProcKindSet = True
Else
RaiseReadOnlyPropertyError
End If
End Property
Public Property Get ParentModule() As CodeModule
If isParentModSet Then
Set ParentModule = mParentModule
Else
RaiseObjectNotIntializedError
End If
End Property
Public Property Let ParentModule(ByRef vNewValue As CodeModule)
If Not isParentModSet Then
Set mParentModule = vNewValue
isParentModSet = True
Else
RaiseReadOnlyPropertyError
End If
End Property
Public Property Get StartLine() As Long
If isParentModSet And isNameSet Then
StartLine = Me.ParentModule.ProcStartLine(Me.Name, Me.ProcKind)
Else
RaiseObjectNotIntializedError
End If
End Property
Public Property Get EndLine() As Long
If isParentModSet And isNameSet Then
EndLine = Me.StartLine + Me.CountOfLines
Else
RaiseObjectNotIntializedError
End If
End Property
Public Property Get CountOfLines() As Long
If isParentModSet And isNameSet Then
CountOfLines = Me.ParentModule.ProcCountLines(Me.Name, Me.ProcKind)
Else
RaiseObjectNotIntializedError
End If
End Property
Public Sub initialize(Name As String, codeMod As CodeModule, ProcKind As vbext_ProcKind)
Me.Name = Name
Me.ParentModule = codeMod
Me.ProcKind = ProcKind
End Sub
Public Property Get Lines() As String
If isParentModSet And isNameSet Then
Lines = Me.ParentModule.Lines(Me.StartLine, Me.CountOfLines)
Else
RaiseObjectNotIntializedError
End If
End Property
Private Sub RaiseObjectNotIntializedError()
Err.Raise vbObjectError + vbeProcedureError + 10, ThisWorkbook.Name & "." & TypeName(Me), "Object Not Initialized"
End Sub
Private Sub RaiseReadOnlyPropertyError()
Err.Raise vbObjectError + vbeProcedureError + 20, ThisWorkbook.Name & "." & TypeName(Me), "Property is Read-Only after initialization"
End Sub
@KotorinChunChun

This comment has been minimized.

Copy link
Owner Author

@KotorinChunChun KotorinChunChun commented Jan 30, 2020

  • StackOverflowのソースコードの不完全な箇所を整備
  • Access用コードからExcel用コードへ変更
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.