Public VBInstance As VBIde.VBE
Public Connect As Connect
Dim strDefPath As String
Option Explicit
Private Sub CancelButton_Click()
Unload Me
Connect.Hide
End Sub
Private Sub Form_Load()
Dim objComponent As VBComponent
Dim objMember As Member
Dim strTemp As String
Dim intTemp As Integer
Dim strCurrExports()
ReDim strCurrExports(0)
'find the path for the .def file of the current project
strDefPath = VBInstance.ActiveVBProject.FileName
If strDefPath = "" Then
MsgBox "Please save your project before choosing what you want to export.", vbInformation, "Make DLLs"
Unload Me
Connect.Hide
Exit Sub
End If
strDefPath = Left$(strDefPath, Len(strDefPath) - 3) & "def"
On Error GoTo nofile
'try to open existing definition file
Open strDefPath For Input As #1
chkMakeDLL.Value = 1
Do Until EOF(1)
Line Input #1, strTemp
Select Case Left$(Trim(strTemp), 7)
Case "LIBRARY"
Case "EXPORTS"
Case Else
ReDim Preserve strCurrExports(UBound(strCurrExports) + 1)
strCurrExports(UBound(strCurrExports)) = Trim$(strTemp)
End Select
Loop
Close #1
dontread:
'enumerate the procedures in every module file within
'the current project
For Each objComponent In VBInstance.ActiveVBProject.VBComponents
If objComponent.Type = vbext_ct_StdModule Then
For Each objMember In objComponent.CodeModule.Members
If objMember.Type = vbext_mt_Method Then
lstExport.AddItem objMember.Name & " (defined in " & objComponent.Name & ")"
'check if the procedure is mardked to be exported.
'if so, tick the box next to it.
For intTemp = 1 To UBound(strCurrExports)
If strCurrExports(intTemp) = objMember.Name Then
lstExport.Selected(lstExport.ListCount - 1) = True
End If
Next
End If
Next
End If
Next
Exit Sub
nofile:
'file didn't exist, makedll checkbox = 0
chkMakeDLL.Value = 0
Resume dontread
End Sub
Private Sub OKButton_Click()
On Error GoTo errorhandle
Dim intTemp As Integer
Dim strTemp
If chkMakeDLL.Value = 1 Then
'open the .def file for the project - this says all
'the exports in the end dll file.
Open strDefPath For Output As #1
Print #1, "LIBRARY " & VBInstance.ActiveVBProject.Name
Print #1, "EXPORTS"
'go throgh all procs in the list box. If it is
'ticked, write the name of it into the file
For intTemp = 0 To lstExport.ListCount - 1
If lstExport.Selected(intTemp) = True Then
Print #1, " " & Split(lstExport.List(intTemp), " ")(0)
End If
Next
Else
On Error Resume Next
Kill strDefPath
On Error GoTo errorhandle
End If
endit:
'close any files which are still open
Close
Unload Me
Connect.Hide
Exit Sub
errorhandle:
Select Case MsgBox("An error occured while writing the definition file: " _
& Err.Description & " (" & Err.Number & ")", _
vbAbortRetryIgnore + vbCritical, "Error")
Case vbAbort
Resume endit
Case vbRetry
Resume
Case vbIgnore
Resume Next
End Select
End Sub
uj5u.com熱心網友回復：
具體是那句的問題？轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/123928.html
標籤：VBA