📄 mdldatabase3.bas
字号:
strTempFile = GetTempPathW & "Guider.doc"
'循环检索所有关键字
For intGuiderIndex = 1 To intGuiderNumber
'第一步，检索模板文件
strValue = GetINI(strConfigFile, "Guider" & CStr(intGuiderIndex), "TemplateFile", "")
If strValue <> "" Then
strTemplateFile = gstrCurrPath & TemplateDir & strValue
'模板文件是否存在
If Dir(strTemplateFile) = "" Then
MsgBox "模板文件 " & strTemplateFile & " 不存在，无法输出导引单！", _
vbInformation, "提示"
GoTo ExitLab
End If
'第二步，检查是否最后一种格式
blnOther = False: blnAll = False
If InStr(1, UCase(strValue), "OTHER") >= 1 Then
'其它类型
blnOther = True
Else
'非其它类型
'是否全部类型
If InStr(1, UCase(strValue), "ALL") >= 1 Then
'全部类型
blnAll = True
End If
End If
'加一步骤，获取打印机名称
strValue = GetINI(strConfigFile, "Guider" & CStr(intGuiderIndex), "PrinterName", "")
strPrinter = strValue
'第三步，是否显示子项
strValue = GetINI(strConfigFile, "Guider" & CStr(intGuiderIndex), "ShowChild", "")
strValue = UCase(strValue)
If strValue = "TRUE" Then
blnShowChild = True
Else
blnShowChild = False
End If
'第四步，获取关键字数目
strValue = GetINI(strConfigFile, "Guider" & CStr(intGuiderIndex), "KeyNumber", "")
intKeyNumber = CInt(Val(strValue))
' If (intKeyNumber < 1) And (blnOther = False) Then
' MsgBox "配置文件 " & strConfigFile & " 不完整，请联系系统管理员！", _
' vbExclamation, "提示"
' GoTo ExitLab
' End If
'第五步，循环检索所有关键字
strCurrentKeyWord = ""
If intKeyNumber > 0 Then
'重定义数组大小
ReDim strKeyWord(1 To intKeyNumber)
ReDim strKeyCode(1 To intKeyNumber)
For intKeyIndex = 1 To intKeyNumber
'检索关键字和编码
strValue = GetINI(strConfigFile, "Guider" & CStr(intGuiderIndex), _
"KeyWord" & CStr(intKeyIndex), "")
intPosition = InStr(strValue, "=")
strKeyWord(intKeyIndex) = Mid(strValue, intPosition + 1)
strKeyCode(intKeyIndex) = Left(strValue, intPosition - 1)
strCurrentKeyWord = strCurrentKeyWord & "'" & strKeyWord(intKeyIndex) & "'" & ","
Next intKeyIndex
'截掉最后的逗号
strCurrentKeyWord = Left(strCurrentKeyWord, Len(strCurrentKeyWord) - 1)
'添加到所有关键字中
If Not blnOther Then
strAllKeyWord = strAllKeyWord & strCurrentKeyWord & ","
End If
Else
'重定义数组大小
ReDim strKeyWord(1 To 1)
ReDim strKeyCode(1 To 1)
strKeyWord(1) = ""
strKeyCode(1) = ""
intXMCount = 1
End If
If blnSelectedIndex(intGuiderIndex) Then
'第五步，打印当前格式的导引单
strSQL = "select DXID,DXMC,DXJG,DXZYSX,SET_KSSZ.KSMC from SET_DX,SET_KSSZ" _
& " where DXID in("
If Not blnNoSelection Then
strSQL = strSQL & "select DXID from YY_SJDJDX" _
& " where GUID=" & lngGUID
Else
strSQL = strSQL & "select DXID from YY_TJDJDX" _
& " where YYID='" & strYYID & "'" _
& " and FZID=" & intFZID
End If
strSQL = strSQL & ")" _
& " and SET_DX.KSID=SET_KSSZ.KSID"
If blnOther Then
'截掉最后的逗号
If Right(strAllKeyWord, 1) = "," Then
strAllKeyWord = Left(strAllKeyWord, Len(strAllKeyWord) - 1)
End If
If strAllKeyWord <> "" Then
strSQL = strSQL & " and DXMC not in(" _
& strAllKeyWord _
& ")"
End If
ElseIf blnAll Then
'
Else
If strCurrentKeyWord <> "" Then
strSQL = strSQL & " and DXMC in(" _
& strCurrentKeyWord _
& ")"
Else
strSQL = strSQL & " and DXMC in(" _
& "'Shit'" _
& ")"
End If
End If
strSQL = strSQL & " order by SET_KSSZ.SXH,SET_DX.SXH"
Set rsDX = New ADODB.Recordset
rsDX.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
If rsDX.EOF Then
If intKeyNumber <= -1 Then '说明是封面
'第六步，创建word文件
GoSub CreateWordDocument
'第七步，打印个人信息
GoSub PrintPersonInfo
'打印文档（比如封面一类）
GoSub PrintWordDocument
End If
Else
'第六步，创建word文件
GoSub CreateWordDocument
'第七步，打印个人信息
GoSub PrintPersonInfo
'第八步，打印项目信息
'循环处理所有大项
For i = 1 To rsDX.RecordCount
intXMIndex = i
If intXMIndex > intXMCount Then
'重新设置索引
If intXMCount > 1 Then
intXMIndex = intXMIndex Mod intXMCount
Else
intXMIndex = 1
End If
'是否需要打印个人信息
If intXMIndex = 1 Then
'首先输出上一页纸
GoSub PrintWordDocument
'创建word文件
GoSub CreateWordDocument
'打印新页的个人信息
GoSub PrintPersonInfo
End If
End If
'循环所有书签
For Each bookColl In bookColls
strBookName = bookColl.name
strID = GetIDFromBookMark(strBookName, False)
If Len(strID) >= 2 Then
strHeader = Left(strID, 1) '记录头部标识
strID = Mid(strID, 2) '去掉头部
If strID = CStr(intXMIndex) Then
strPrint = ""
strSQL = ""
Select Case strHeader
Case gtypHeader.BOOKMARK_NAME
strSQL = "select YYRXM from SET_GRXX" _
& " where GUID=" & lngGUID
Case gtypHeader.BOOKMARK_SEX
strSQL = "select SEX from SET_GRXX" _
& " where GUID=" & lngGUID
Case gtypHeader.BOOKMARK_AGE
strSQL = "select AGE from SET_GRXX" _
& " where GUID=" & lngGUID
Case gtypHeader.BOOKMARK_XM
strPrint = rsDX("DXMC")
'大项价格和
If Not IsNull(rsDX("DXJG")) Then
curTotalPricePerPage = curTotalPricePerPage + rsDX("DXJG")
End If
Case gtypHeader.BOOKMARK_SELECTION
strPrint = "□"
Case gtypHeader.BOOKMARK_BM
For j = LBound(strKeyWord) To UBound(strKeyWord)
If strKeyWord(j) = rsDX("DXMC") Then
strPrint = strKeyCode(j)
Exit For
End If
Next j
Case gtypHeader.BOOKMARK_JG
strPrint = CStr(rsDX("DXJG") & "")
Case gtypHeader.BOOKMARK_ZYSX
strPrint = rsDX("DXZYSX") & ""
Case gtypHeader.BOOKMARK_KSMC
strPrint = rsDX("KSMC")
Case Else
'
End Select
'是否需要查询
If strSQL <> "" Then
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
If Not rstemp.EOF Then
strPrint = rstemp(0) & ""
rstemp.Close
End If
End If
If strPrint <> "" Then
bookColl.Range.Text = strPrint
'是否需要打印小项
If blnShowChild Then
If strHeader = gtypHeader.BOOKMARK_XM Then
strSQL = "select XXMC from SET_XX" _
& " where XXID in(" _
& "select XXID from SET_ZH_DATA" _
& " where DXID='" & rsDX("DXID") & "'" _
& ")" _
& " order by SET_XX.SXH"
Set rsXX = New ADODB.Recordset
rsXX.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
If Not rsXX.EOF Then
For j = 1 To rsXX.RecordCount
For Each bookCollChild In bookColls
strBookName = bookCollChild.name
strID = GetIDFromBookMark(strBookName, False)
If Len(strID) >= 2 Then
strHeader = Left(strID, 1) '记录头部标识
strID = Mid(strID, 2) '去掉头部
If (strHeader = gtypHeader.BOOKMARK_XX) Or _
((strHeader = gtypHeader.BOOKMARK_XB)) Then
If InStr(1, strID, BookMarkSeparator) < 1 Then
strID = strID & BookMarkSeparator & "1"
End If
If (Left(strID, InStr(1, strID, BookMarkSeparator) - 1) = CStr(intXMIndex)) _
And (Mid(strID, InStr(1, strID, BookMarkSeparator) + 1) = CStr(j)) Then
If strHeader = gtypHeader.BOOKMARK_XX Then
bookCollChild.Range.Text = rsXX("XXMC")
Else
For K = LBound(strKeyWord) To UBound(strKeyWord)
If strKeyWord(K) = rsXX("XXMC") Then
bookCollChild.Range.Text = strKeyCode(K)
Exit For
End If
Next K
End If
Exit For
End If
End If
End If
Next
rsXX.MoveNext
Next j
rsXX.Close
End If
End If
End If
End If
End If
End If
Next
rsDX.MoveNext
Next i
'第九步，输出到打印机
GoSub PrintWordDocument
rsDX.Close
End If
End If
End If
Next intGuiderIndex
GoTo ExitLab
CreateWordDocument:
'第六步，创建word文件
If Dir(strTempFile) <> "" Then Kill strTempFile
Call FileCopy(strTemplateFile, strTempFile)
Set docTemps = WordTemps.Documents.Open(FileName:="""" & strTempFile & """", _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto)
Set bookColls = docTemps.Bookmarks
Return
PrintWordDocument:
'是否打印页价格和
' If strBookNameOfTotalPrice <> "" Then
' docTemps.Bookmarks(strBookNameOfTotalPrice).Range.Text = CStr(curTotalPricePerPage)
' End If
' Call PrintWordDocument(WordTemps, st⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -