纯vb 根据excel模版 生成窗体
首先看页面样子，见上图
以下是vb代码
Option Explicit
Public pTags As String
Dim aaa As String
Dim iTags() As String
Dim i, j, k, M, p, T, r As Long
Dim cSql As String
Dim cSql1 As String
Dim cRec As rdoResultset
Dim cRec1 As rdoResultset
Dim cRecT As rdoResultset
Dim cType_Code As String
Dim iType As String
Dim bPact As Boolean
Dim c1 As String
Dim c2 As String
Dim GroupNo As String
Dim Size As String '广告尺寸
Dim Position As String '广告位置
Dim sType As String '广告类型
Dim VarOld, VarNew As Long
Dim var As Long
Dim var2 As Long
Dim a As Long
Dim b As Long
Dim dMin As String '最小日期
Dim dMax As Long '最大日期
Dim cMonth As String
Dim dtend As Date '当前月的最后一天
Dim dtbegin As Date '当前月的第一天
Dim oldGroup_no As String
Dim newGroup_no As String
Dim price As String '单价
Dim d1 As Date
Dim d2 As Date
Private Sub cmdOk_Click()
If Option1(0).Value = True Then '同方模版
TongFang
fpSpr.SetText 1, 2, "网站"
fpSpr.SetText 1, 4, "It168"
fpSpr.SetText 2, 2, "创意形式/尺寸"
fpSpr.SetText 3, 2, "位置"
fpSpr.SetText 4, 2, "广告形式"
fpSpr.SetText 5, 1, "日均"
fpSpr.SetText 5, 2, "页面流量"
fpSpr.SetText 5, 3, "(‘000)"
fpSpr.SetText 6, 1, "计划"
fpSpr.SetText 6, 2, "浏览量"
fpSpr.SetText 6, 3, "(‘000)"
fpSpr.SetText 7, 1, "预计"
fpSpr.SetText 7, 2, "点击率"
fpSpr.SetText 7, 3, "%"
fpSpr.SetText 8, 1, "预计"
fpSpr.SetText 8, 2, "点击数量"
fpSpr.SetText 9, 1, "预计"
fpSpr.SetText 9, 2, "点击成本"
fpSpr.SetText 9, 3, "RMB"
fpSpr.SetText k, 2, "总天数"
fpSpr.SetText k + 1, 2, "单价"
fpSpr.SetText k + 2, 2, "折扣"
fpSpr.SetText k + 3, 2, "价格/天"
fpSpr.SetText k + 4, 2, "总计人民币"
fpSpr.ColWidth(1) = 6
fpSpr.ColWidth(2) = 14
fpSpr.ColWidth(3) = 14
fpSpr.ColWidth(4) = 14
fpSpr.ColWidth(5) = 10
fpSpr.ColWidth(6) = 9
fpSpr.ColWidth(7) = 9
fpSpr.ColWidth(8) = 9
fpSpr.ColWidth(9) = 10
' fpSpr.ColWidth(10) = 6
fpSpr.ColWidth(k) = 6
fpSpr.ColWidth(k + 1) = 8
fpSpr.ColWidth(k + 2) = 6
fpSpr.ColWidth(k + 3) = 6
fpSpr.ColWidth(k + 4) = 12
End If
If Option1(1).Value = True Then
SanXin
' bPact = False
fpSpr.SetText 1, 2, "Media"
fpSpr.SetText 1, 4, "It168" 'Impression
fpSpr.SetText 2, 2, "Impression"
fpSpr.SetText 3, 2, "CTR"
fpSpr.SetText 4, 2, "Click"
fpSpr.SetText 5, 2, "Channel"
fpSpr.SetText 6, 2, "Site"
fpSpr.SetText 7, 2, "Type"
fpSpr.SetText 8, 2, "Size"
fpSpr.SetText 9, 2, "投放天数"
fpSpr.SetText 10, 2, "单价"
fpSpr.SetText 11, 2, "折扣"
fpSpr.SetText 12, 2, "折后价"
fpSpr.SetText 13, 2, "Total Net Cost"
fpSpr.SetText k, 2, "URL"
fpSpr.ColWidth(1) = 6
fpSpr.ColWidth(2) = 14
fpSpr.ColWidth(3) = 6
fpSpr.ColWidth(4) = 8
fpSpr.ColWidth(5) = 10
fpSpr.ColWidth(6) = 9
fpSpr.ColWidth(7) = 9
fpSpr.ColWidth(8) = 9
fpSpr.ColWidth(9) = 10
fpSpr.ColWidth(10) = 6
fpSpr.ColWidth(11) = 8
fpSpr.ColWidth(12) = 8
fpSpr.ColWidth(13) = 8
' MsgBox "三星模版"
End If
If Option1(2).Value = True Then
HuiPu
' bPact = False
fpSpr.SetText 1, 2, "Website(站点)"
fpSpr.SetText 1, 4, "It168"
fpSpr.SetText 2, 2, "Channel/Position"
fpSpr.SetText 3, 2, "Format"
fpSpr.SetText 4, 2, "Size"
fpSpr.SetText 5, 2, "Position"
fpSpr.SetText 6, 2, "URL"
fpSpr.SetText 7, 2, "Impression"
fpSpr.SetText 8, 2, "投放天数"
fpSpr.SetText k, 2, "刊特价"
fpSpr.SetText k + 1, 2, "折后价"
fpSpr.SetText k + 2, 1, "Negotiated Cost Per "
fpSpr.SetText k + 2, 2, "Spot Local Net Net"
fpSpr.SetText k + 3, 1, "Cost Per Spot US"
fpSpr.SetText k + 3, 2, "$ Net Net"
fpSpr.SetText k + 4, 2, "Total Local Net Net"
fpSpr.SetText k + 5, 1, "Total Nett Cost "
fpSpr.SetText k + 5, 2, "(USD)"
fpSpr.ColWidth(1) = 6
fpSpr.ColWidth(2) = 14
fpSpr.ColWidth(3) = 6
fpSpr.ColWidth(4) = 8
fpSpr.ColWidth(5) = 10
fpSpr.ColWidth(6) = 9
fpSpr.ColWidth(7) = 9
fpSpr.ColWidth(8) = 9
fpSpr.ColWidth(k) = 6
fpSpr.ColWidth(k + 1) = 6
fpSpr.ColWidth(k + 2) = 14
fpSpr.ColWidth(k + 3) = 14
fpSpr.ColWidth(k + 4) = 14
fpSpr.ColWidth(k + 5) = 14
' MsgBox "惠普模版"
End If
If Option1(3).Value = True Then
FangZheng
' bPact = False
fpSpr.SetText 1, 2, "媒体"
fpSpr.SetText 1, 4, "It168"
fpSpr.SetText 2, 2, "位置"
fpSpr.SetText 3, 2, "广告形式"
fpSpr.SetText 4, 2, "预估PV"
fpSpr.SetText 5, 2, "广告规格"
fpSpr.SetText 6, 2, "单位"
fpSpr.SetText 7, 2, "数量"
fpSpr.SetText 8, 2, "单价"
fpSpr.SetText 9, 2, "折扣"
fpSpr.SetText 10, 2, "金额"
fpSpr.SetText k, 2, "预估总PV"
fpSpr.ColWidth(1) = 6
fpSpr.ColWidth(2) = 14
fpSpr.ColWidth(3) = 14
fpSpr.ColWidth(4) = 14
fpSpr.ColWidth(5) = 10
fpSpr.ColWidth(6) = 4
fpSpr.ColWidth(7) = 4
fpSpr.ColWidth(8) = 6
fpSpr.ColWidth(9) = 6
fpSpr.ColWidth(10) = 6
fpSpr.ColWidth(k) = 9
' MsgBox "方正模版"
End If
If Option1(4).Value = True Then
DianTong
fpSpr.SetText 1, 1, "类型"
fpSpr.SetText 1, 2, "Type"
fpSpr.SetText 2, 1, "网站"
fpSpr.SetText 2, 2, "WebSite"
fpSpr.SetText 2, 4, "It168"
fpSpr.SetText 3, 1, "广告位置"
fpSpr.SetText 3, 2, "Position"
fpSpr.SetText 4, 1, "nb"
fpSpr.SetText 4, 2, "AD Form"
fpSpr.SetText 5, 1, "广告规格"
fpSpr.SetText 5, 2, "Size"
fpSpr.SetText 6, 1, "投放量"
fpSpr.SetText 7, 1, "单位"
fpSpr.SetText 7, 2, "Unit"
fpSpr.SetText k, 2, "刊例单价"
fpSpr.SetText k + 1, 2, "刊例总价"
fpSpr.SetText k + 2, 2, "折扣"
fpSpr.SetText k + 3, 2, "折后单价"
fpSpr.SetText k + 4, 2, "折后总价"
fpSpr.SetText k + 5, 2, "网站总价"
fpSpr.ColWidth(1) = 8
fpSpr.ColWidth(2) = 8
fpSpr.ColWidth(3) = 14
fpSpr.ColWidth(4) = 14
fpSpr.ColWidth(5) = 14
fpSpr.ColWidth(6) = 6
fpSpr.ColWidth(7) = 6
fpSpr.ColWidth(k) = 7
fpSpr.ColWidth(k + 1) = 7
fpSpr.ColWidth(k + 2) = 7
fpSpr.ColWidth(k + 3) = 7
fpSpr.ColWidth(k + 4) = 7
fpSpr.ColWidth(k + 5) = 7
' MsgBox "电通模版"
End If
If Option1(5).Value = True Then
Intel
fpSpr.SetText 1, 2, "Online"
fpSpr.SetText 1, 4, "It168"
fpSpr.SetText 2, 2, "URL(页面地址)"
fpSpr.SetText 3, 2, "广告尺寸"
fpSpr.SetText 4, 2, "广告位置"
fpSpr.SetText 5, 2, "广告类型"
fpSpr.SetText 6, 1, "Total"
fpSpr.SetText 6, 2, "Daily Traffic"
fpSpr.SetText 6, 3, "Pg View(000)"
fpSpr.SetText 7, 1, "Planned"
fpSpr.SetText 7, 2, "Total"
fpSpr.SetText 7, 3, "Imp.(000)"
fpSpr.SetText 8, 1, "Estimated"
fpSpr.SetText 8, 2, "CTR*"
fpSpr.SetText 9, 1, "Projected"
fpSpr.SetText 9, 2, "Clicks"
fpSpr.SetText k, 2, "投放天数"
fpSpr.SetText k + 1, 2, "折扣"
fpSpr.SetText k + 2, 2, "Cost / Day"
fpSpr.SetText k + 2, 3, "US$"
fpSpr.SetText k + 3, 2, "Cost / '000"
fpSpr.SetText k + 3, 3, "Imp."
fpSpr.SetText k + 4, 2, "Cost / Click"
fpSpr.SetText k + 5, 2, "Net Media"
fpSpr.SetText k + 5, 3, "Total US$"
fpSpr.SetText k + 6, 2, "Tax US$"
fpSpr.SetText k + 7, 2, "Grand Total"
fpSpr.SetText k + 7, 3, "US$"
fpSpr.SetText k + 8, 2, "Grand Total"
fpSpr.SetText k + 8, 3, "RMB"
fpSpr.SetText k + 9, 2, "Share %"
fpSpr.ColWidth(1) = 6
fpSpr.ColWidth(2) = 10
fpSpr.ColWidth(3) = 14
fpSpr.ColWidth(4) = 14
fpSpr.ColWidth(5) = 14
fpSpr.ColWidth(6) = 9
fpSpr.ColWidth(7) = 8
fpSpr.ColWidth(8) = 8
fpSpr.ColWidth(9) = 8
fpSpr.ColWidth(k) = 8
fpSpr.ColWidth(k + 1) = 4
fpSpr.ColWidth(k + 2) = 8
fpSpr.ColWidth(k + 3) = 8
fpSpr.ColWidth(k + 4) = 8
fpSpr.ColWidth(k + 5) = 8
fpSpr.ColWidth(k + 6) = 8
fpSpr.ColWidth(k + 7) = 9
fpSpr.ColWidth(k + 8) = 8
fpSpr.ColWidth(k + 9) = 8
' MsgBox "Intel模版"
End If
If Option1(6).Value = True Then
IBM
fpSpr.SetText 1, 2, "Titles/Channels/WebSites"
fpSpr.SetText 1, 4, "It168"
fpSpr.SetText 2, 2, "广告形式"
fpSpr.SetText 3, 2, "广告位置"
fpSpr.SetText 4, 1, "URL/Description"
fpSpr.SetText 4, 2, "(页面地址)"
fpSpr.SetText 5, 2, "广告尺寸"
fpSpr.SetText 6, 2, "广告大小"
fpSpr.SetText 7, 2, "净价"
fpSpr.SetText 8, 2, "天数"
fpSpr.SetText 9, 2, "总价=单价*日期"
fpSpr.SetText 10, 2, "总额 /RMB"
fpSpr.SetText 11, 2, "总额/USD"
fpSpr.ColWidth(1) = 18
fpSpr.ColWidth(2) = 10
fpSpr.ColWidth(3) = 10
fpSpr.ColWidth(4) = 12
fpSpr.ColWidth(5) = 10
fpSpr.ColWidth(6) = 8
fpSpr.ColWidth(7) = 8
fpSpr.ColWidth(8) = 8
fpSpr.ColWidth(9) = 14
fpSpr.ColWidth(10) = 8
fpSpr.ColWidth(11) = 8
' MsgBox "IBM模版"
End If
End Sub
Sub TongFang() '同方模版
fpSpr.Col = -1
fpSpr.Row = -1
fpSpr.Text = ""
fpSpr.BackColor = &HFFFFFF
k = 10
pTags = Left(pTags, Len(pTags) - 0) 'pTags是传过来的字符串
iTags = Split(pTags, ",")
M = 3
cSql = " select min(dFrom_date) as dMin,max(dTo_date) as dMax " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no in ( " & pTags & ") "
Set cRecT = gData.OpenResultset(cSql, rdOpenKeyset)
dtbegin = DateSerial(Year(cRecT("dMin")), Month(cRecT("dMin")), 1)
dtend = DateSerial(Year(cRecT("dMax")), Month(cRecT("dMax")) + 1, 1) - 1
For p = 10 To DateDiff("m", dtbegin, dtend) + 10 '日历头显示(月,星期,日)
fpSpr.Col = k
fpSpr.Row = 1
cMonth = Format(DateAdd("m", p - 10, dtbegin), "yyyy-mm-dd")
fpSpr.Text = Format(cMonth, "mm")
d1 = DateSerial(Year(cMonth), Month(cMonth), 1) ' 当月第一天
d2 = DateSerial(Year(cMonth), Month(cMonth) + 1, 1) - 1 '当月最后一天
' d1 = DateTime.DateAdd("d", -2, cMonth)
' d2 = DateTime.DateAdd("d", 1, cMonth)
For j = 10 To DateDiff("d", d1, d2) + 10
fpSpr.Col = k
fpSpr.Row = 3
fpSpr.Text = Format(DateAdd("d", j - 10, d1), "dd")
fpSpr.ColWidth(k) = 2
k = k + 1
Select Case Weekday(DateAdd("d", j - 10, d1))
Case 7:
fpSpr.Row = 2
fpSpr.Text = "六"
fpSpr.BackColor = &HC0C0FF
Case 1:
fpSpr.Row = 2
fpSpr.Text = "日"
fpSpr.BackColor = &HC0C0FF
Case 2:
fpSpr.Row = 2
fpSpr.Text = "一"
Case 3:
fpSpr.Row = 2
fpSpr.Text = "二"
Case 4:
fpSpr.Row = 2
fpSpr.Text = "三"
Case 5:
fpSpr.Row = 2
fpSpr.Text = "四"
Case 6:
fpSpr.Row = 2
fpSpr.Text = "五"
End Select
Next j
Next p
T = 0
fpSpr.MaxRows = UBound(iTags) + 4
For i = 0 To UBound(iTags)
iType = iTags(i)
cSql1 = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,n.iType_id " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec1 = gData.OpenResultset(cSql1, rdOpenKeyset)
While Not cRec1.EOF
newGroup_no = cRec1("iType_id")
If newGroup_no = oldGroup_no Then
If M = 3 Then
M = 4
End If
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 10 + var To DateDiff("d", c1, c2) + 10 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
' fpSpr.Text = Format(DateAdd("d", a - 11 - var, CDate(c1)), "MM-DD")
fpSpr.Text = Format(DateAdd("d", a - 10 - var, CDate(c1)), 1)
T = T + 1
Next a
Else
T = 0
M = M + 1
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 10 + var To DateDiff("d", c1, c2) + 10 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
' fpSpr.Text = Format(DateAdd("d", a - 11 - var, CDate(c1)), "MM-DD")
fpSpr.Text = Format(DateAdd("d", a - 10 - var, CDate(c1)), 1)
T = T + 1
Next a
End If
' fpSpr.SetText k, M, T
oldGroup_no = cRec1("iType_id")
cRec1.MoveNext
Wend
cSql = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,nn.iLargess_Invo " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "inner join tbl_NetPrice_NoProduct nn on nn.cGroup_No = g.cGroup_No " _
& "where nn.cUnit ='/天' and " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec = gData.OpenResultset(cSql, rdOpenKeyset)
While Not cRec.EOF '显示选定日期
GroupNo = cRec(0)
c1 = cRec("dFrom_date")
c2 = cRec("dTo_Date")
Size = cRec("size")
Position = cRec("cPosition")
sType = cRec("cType")
price = cRec("iLargess_Invo")
'用一行显示出现的日期
' dtbegin = DateSerial(Year(c1), Month(c1), 1)
' var = DateDiff("d", dtbegin, c1)
' dtend = DateSerial(Year(c1), Month(c1) + 1, 1) - 1
' var = Format(DateAdd("m", 0, dtbegin), "mm")
' VarOld = Format(DateAdd("m", 0, dtbegin), "mm")
' For j = 10 To DateDiff("d", CDate(c1), CDate(c2)) + 10
' fpSpr.Col = k
' fpSpr.Row = M
' fpSpr.Text = Format(DateAdd("d", j - 10, CDate(c1)), "yyyy-mm-dd")
' k = k + 1
' '周六,周日用不同的颜色显示
' If Weekday(DateAdd("d", j - 10, CDate(c1))) = 7 Then
' fpSpr.Text = fpSpr.Text + "(六)"
' fpSpr.Row = M
' fpSpr.BackColor = &HC0C0FF
' End If
' If Weekday(DateAdd("d", j - 10, CDate(c1))) = 1 Then
' fpSpr.Text = fpSpr.Text + "(日)"
' fpSpr.Row = M
' fpSpr.BackColor = &HC0C0FF
' End If
' fpSpr.ColWidth(k) = 10
' Next j
fpSpr.SetText 2, M, Size
fpSpr.SetText 3, M, Position
fpSpr.SetText 4, M, sType
fpSpr.SetText k, M, T
fpSpr.SetText k + 1, M, price
cRec.MoveNext
Wend
Next
fpSpr.MaxCols = k + 4
fpSpr.MaxRows = M + 1
End Sub
Sub SanXin() '三星模版
fpSpr.Col = -1
fpSpr.Row = -1
fpSpr.Text = ""
fpSpr.BackColor = &HFFFFFF '无色
k = 14
pTags = Left(pTags, Len(pTags) - 0)
iTags = Split(pTags, ",")
M = 3
cSql = " select min(dFrom_date) as dMin,max(dTo_date) as dMax " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no in ( " & pTags & ") "
Set cRecT = gData.OpenResultset(cSql, rdOpenKeyset)
dtbegin = DateSerial(Year(cRecT("dMin")), Month(cRecT("dMin")), 1)
dtend = DateSerial(Year(cRecT("dMax")), Month(cRecT("dMax")) + 1, 1) - 1
For p = 14 To DateDiff("m", dtbegin, dtend) + 14 '日历头显示(月,星期,日)
fpSpr.Col = k
fpSpr.Row = 1
cMonth = Format(DateAdd("m", p - 14, dtbegin), "yyyy-mm-dd")
fpSpr.Text = fun(Format(cMonth, "mm"))
d1 = DateSerial(Year(cMonth), Month(cMonth), 1) ' 当月第一天
d2 = DateSerial(Year(cMonth), Month(cMonth) + 1, 1) - 1 '当月最后一天
For j = 14 To DateDiff("d", d1, d2) + 14
fpSpr.Col = k
fpSpr.Row = 3
fpSpr.Text = Format(DateAdd("d", j - 14, d1), "dd")
fpSpr.ColWidth(k) = 2
k = k + 1
Select Case Weekday(DateAdd("d", j - 14, d1))
Case 7:
fpSpr.Row = 2
fpSpr.Text = "六"
fpSpr.BackColor = &HC0C0FF
Case 1:
fpSpr.Row = 2
fpSpr.Text = "日"
fpSpr.BackColor = &HC0C0FF
Case 2:
fpSpr.Row = 2
fpSpr.Text = "一"
Case 3:
fpSpr.Row = 2
fpSpr.Text = "二"
Case 4:
fpSpr.Row = 2
fpSpr.Text = "三"
Case 5:
fpSpr.Row = 2
fpSpr.Text = "四"
Case 6:
fpSpr.Row = 2
fpSpr.Text = "五"
End Select
Next j
Next p
T = 0
fpSpr.MaxRows = UBound(iTags) + 4
For i = 0 To UBound(iTags)
iType = iTags(i)
cSql1 = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,n.iType_id " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec1 = gData.OpenResultset(cSql1, rdOpenKeyset)
While Not cRec1.EOF
newGroup_no = cRec1("iType_id")
If newGroup_no = oldGroup_no Then
If M = 3 Then
M = 4
End If
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 14 + var To DateDiff("d", c1, c2) + 14 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 14 - var, CDate(c1)), 1)
T = T + 1
Next a
Else
T = 0
M = M + 1
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 14 + var To DateDiff("d", c1, c2) + 14 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 14 - var, CDate(c1)), 1)
T = T + 1
Next a
End If
fpSpr.SetText 9, M, T
oldGroup_no = cRec1("iType_id")
cRec1.MoveNext
Wend
cSql = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,nn.iLargess_Invo " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "inner join tbl_NetPrice_NoProduct nn on nn.cGroup_No = g.cGroup_No " _
& "where nn.cUnit ='/天' and " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec = gData.OpenResultset(cSql, rdOpenKeyset)
While Not cRec.EOF '显示选定日期
GroupNo = cRec(0)
c1 = cRec("dFrom_date")
c2 = cRec("dTo_Date")
Size = cRec("size")
Position = cRec("cPosition")
sType = cRec("cType")
price = cRec("iLargess_Invo")
fpSpr.SetText 8, M, Size
fpSpr.SetText 5, M, Position
fpSpr.SetText 7, M, sType
fpSpr.SetText 10, M, price
cRec.MoveNext
Wend
Next
fpSpr.MaxCols = k
fpSpr.MaxRows = M + 1
End Sub
Sub HuiPu()
fpSpr.Col = -1
fpSpr.Row = -1
fpSpr.Text = ""
fpSpr.BackColor = &HFFFFFF '无色
'
k = 9
pTags = Left(pTags, Len(pTags) - 0)
iTags = Split(pTags, ",")
M = 3
cSql = " select min(dFrom_date) as dMin,max(dTo_date) as dMax " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no in ( " & pTags & ") "
Set cRecT = gData.OpenResultset(cSql, rdOpenKeyset)
dtbegin = DateSerial(Year(cRecT("dMin")), Month(cRecT("dMin")), 1)
dtend = DateSerial(Year(cRecT("dMax")), Month(cRecT("dMax")) + 1, 1) - 1
For p = 9 To DateDiff("m", dtbegin, dtend) + 9 '日历头显示(月,星期,日)
fpSpr.Col = k
fpSpr.Row = 1
cMonth = Format(DateAdd("m", p - 9, dtbegin), "yyyy-mm-dd")
fpSpr.Text = fun(Format(cMonth, "mm"))
d1 = DateSerial(Year(cMonth), Month(cMonth), 1) ' 当月第一天
d2 = DateSerial(Year(cMonth), Month(cMonth) + 1, 1) - 1 '当月最后一天
For j = 9 To DateDiff("d", d1, d2) + 9
fpSpr.Col = k
fpSpr.Row = 3
fpSpr.Text = Format(DateAdd("d", j - 9, d1), "dd")
fpSpr.ColWidth(k) = 2
k = k + 1
Select Case Weekday(DateAdd("d", j - 9, d1))
Case 7:
fpSpr.Row = 2
fpSpr.Text = "六"
fpSpr.BackColor = &HC0C0FF
Case 1:
fpSpr.Row = 2
fpSpr.Text = "日"
fpSpr.BackColor = &HC0C0FF
Case 2:
fpSpr.Row = 2
fpSpr.Text = "一"
Case 3:
fpSpr.Row = 2
fpSpr.Text = "二"
Case 4:
fpSpr.Row = 2
fpSpr.Text = "三"
Case 5:
fpSpr.Row = 2
fpSpr.Text = "四"
Case 6:
fpSpr.Row = 2
fpSpr.Text = "五"
End Select
Next j
Next p
T = 0
fpSpr.MaxRows = UBound(iTags) + 4
For i = 0 To UBound(iTags)
iType = iTags(i)
cSql1 = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,n.iType_id " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec1 = gData.OpenResultset(cSql1, rdOpenKeyset)
While Not cRec1.EOF
newGroup_no = cRec1("iType_id")
If newGroup_no = oldGroup_no Then
If M = 3 Then
M = 4
End If
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 9 + var To DateDiff("d", c1, c2) + 9 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 9 - var, CDate(c1)), 1)
T = T + 1
Next a
Else
T = 0
M = M + 1
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 9 + var To DateDiff("d", c1, c2) + 9 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 9 - var, CDate(c1)), 1)
T = T + 1
Next a
End If
fpSpr.SetText 8, M, T
oldGroup_no = cRec1("iType_id")
cRec1.MoveNext
Wend
cSql = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,nn.iLargess_Invo " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "inner join tbl_NetPrice_NoProduct nn on nn.cGroup_No = g.cGroup_No " _
& "where nn.cUnit ='/天' and " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec = gData.OpenResultset(cSql, rdOpenKeyset)
While Not cRec.EOF '显示选定日期
GroupNo = cRec(0)
c1 = cRec("dFrom_date")
c2 = cRec("dTo_Date")
Size = cRec("size")
Position = cRec("cPosition")
sType = cRec("cType")
price = cRec("iLargess_Invo")
fpSpr.SetText 4, M, Size
fpSpr.SetText 5, M, Position
fpSpr.SetText 2, M, Position + "-" + sType
fpSpr.SetText 3, M, sType
fpSpr.SetText k, M, price
cRec.MoveNext
Wend
Next
fpSpr.MaxCols = k + 5
fpSpr.MaxRows = M + 1
End Sub
Sub FangZheng()
fpSpr.Col = -1
fpSpr.Row = -1
fpSpr.Text = ""
fpSpr.BackColor = &HFFFFFF
'
k = 11
pTags = Left(pTags, Len(pTags) - 0)
iTags = Split(pTags, ",")
M = 3
cSql = " select min(dFrom_date) as dMin,max(dTo_date) as dMax " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no in ( " & pTags & ") "
Set cRecT = gData.OpenResultset(cSql, rdOpenKeyset)
dtbegin = DateSerial(Year(cRecT("dMin")), Month(cRecT("dMin")), 1)
dtend = DateSerial(Year(cRecT("dMax")), Month(cRecT("dMax")) + 1, 1) - 1
For p = 11 To DateDiff("m", dtbegin, dtend) + 11 '日历头显示(月,星期,日)
fpSpr.Col = k
fpSpr.Row = 1
cMonth = Format(DateAdd("m", p - 11, dtbegin), "yyyy-mm-dd")
fpSpr.Text = Format(cMonth, "mm") + "月"
d1 = DateSerial(Year(cMonth), Month(cMonth), 1) ' 当月第一天
d2 = DateSerial(Year(cMonth), Month(cMonth) + 1, 1) - 1 '当月最后一天
For j = 11 To DateDiff("d", d1, d2) + 11
fpSpr.Col = k
fpSpr.Row = 3
fpSpr.Text = Format(DateAdd("d", j - 11, d1), "dd")
fpSpr.ColWidth(k) = 2
k = k + 1
Select Case Weekday(DateAdd("d", j - 11, d1))
Case 7:
fpSpr.Row = 2
fpSpr.Text = "六"
fpSpr.BackColor = &HC0C0FF
Case 1:
fpSpr.Row = 2
fpSpr.Text = "日"
fpSpr.BackColor = &HC0C0FF
Case 2:
fpSpr.Row = 2
fpSpr.Text = "一"
Case 3:
fpSpr.Row = 2
fpSpr.Text = "二"
Case 4:
fpSpr.Row = 2
fpSpr.Text = "三"
Case 5:
fpSpr.Row = 2
fpSpr.Text = "四"
Case 6:
fpSpr.Row = 2
fpSpr.Text = "五"
End Select
Next j
Next p
T = 0
fpSpr.MaxRows = UBound(iTags) + 4
For i = 0 To UBound(iTags)
iType = iTags(i)
cSql1 = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,n.iType_id " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec1 = gData.OpenResultset(cSql1, rdOpenKeyset)
While Not cRec1.EOF
newGroup_no = cRec1("iType_id")
If newGroup_no = oldGroup_no Then
If M = 3 Then
M = 4
End If
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 11 + var To DateDiff("d", c1, c2) + 11 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 11 - var, CDate(c1)), 1)
T = T + 1
Next a
Else
T = 0
M = M + 1
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 11 + var To DateDiff("d", c1, c2) + 11 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 11 - var, CDate(c1)), 1)
T = T + 1
Next a
End If
fpSpr.SetText 7, M, T
oldGroup_no = cRec1("iType_id")
cRec1.MoveNext
Wend
cSql = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,nn.iLargess_Invo " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "inner join tbl_NetPrice_NoProduct nn on nn.cGroup_No = g.cGroup_No " _
& "where nn.cUnit ='/天' and " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec = gData.OpenResultset(cSql, rdOpenKeyset)
While Not cRec.EOF '显示选定日期
GroupNo = cRec(0)
c1 = cRec("dFrom_date")
c2 = cRec("dTo_Date")
Size = cRec("size")
Position = cRec("cPosition")
sType = cRec("cType")
price = cRec("iLargess_Invo")
fpSpr.SetText 5, M, Size
fpSpr.SetText 2, M, Position
fpSpr.SetText 3, M, sType
fpSpr.SetText 6, M, "天"
fpSpr.SetText 8, M, price
cRec.MoveNext
Wend
Next
fpSpr.MaxCols = k
fpSpr.MaxRows = M + 1
End Sub
Sub DianTong()
fpSpr.Col = -1
fpSpr.Row = -1
fpSpr.Text = ""
fpSpr.BackColor = &HFFFFFF '无色
'
k = 8
pTags = Left(pTags, Len(pTags) - 0)
iTags = Split(pTags, ",")
M = 3
cSql = " select min(dFrom_date) as dMin,max(dTo_date) as dMax " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no in ( " & pTags & ") "
Set cRecT = gData.OpenResultset(cSql, rdOpenKeyset)
dtbegin = DateSerial(Year(cRecT("dMin")), Month(cRecT("dMin")), 1)
dtend = DateSerial(Year(cRecT("dMax")), Month(cRecT("dMax")) + 1, 1) - 1
For p = 8 To DateDiff("m", dtbegin, dtend) + 8 '日历头显示(月,星期,日)
fpSpr.Col = k
fpSpr.Row = 1
cMonth = Format(DateAdd("m", p - 8, dtbegin), "yyyy-mm-dd")
fpSpr.Text = Format(cMonth, "mm") + "月"
d1 = DateSerial(Year(cMonth), Month(cMonth), 1) ' 当月第一天
d2 = DateSerial(Year(cMonth), Month(cMonth) + 1, 1) - 1 '当月最后一天
For j = 8 To DateDiff("d", d1, d2) + 8
fpSpr.Col = k
fpSpr.Row = 3
fpSpr.Text = Format(DateAdd("d", j - 8, d1), "dd")
fpSpr.ColWidth(k) = 2
k = k + 1
Select Case Weekday(DateAdd("d", j - 8, d1))
Case 7:
fpSpr.Row = 2
fpSpr.Text = "六"
fpSpr.BackColor = &HC0C0FF
Case 1:
fpSpr.Row = 2
fpSpr.Text = "日"
fpSpr.BackColor = &HC0C0FF
Case 2:
fpSpr.Row = 2
fpSpr.Text = "一"
Case 3:
fpSpr.Row = 2
fpSpr.Text = "二"
Case 4:
fpSpr.Row = 2
fpSpr.Text = "三"
Case 5:
fpSpr.Row = 2
fpSpr.Text = "四"
Case 6:
fpSpr.Row = 2
fpSpr.Text = "五"
End Select
Next j
Next p
T = 0
fpSpr.MaxRows = UBound(iTags) + 4
For i = 0 To UBound(iTags)
iType = iTags(i)
cSql1 = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,n.iType_id " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec1 = gData.OpenResultset(cSql1, rdOpenKeyset)
While Not cRec1.EOF
newGroup_no = cRec1("iType_id")
If newGroup_no = oldGroup_no Then
If M = 3 Then
M = 4
End If
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 8 + var To DateDiff("d", c1, c2) + 8 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 8 - var, CDate(c1)), 1)
T = T + 1
Next a
Else
T = 0
M = M + 1
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 8 + var To DateDiff("d", c1, c2) + 8 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 8 - var, CDate(c1)), 1)
T = T + 1
Next a
End If
fpSpr.SetText 6, M, T
oldGroup_no = cRec1("iType_id")
cRec1.MoveNext
Wend
cSql = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,nn.iLargess_Invo " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "inner join tbl_NetPrice_NoProduct nn on nn.cGroup_No = g.cGroup_No " _
& "where nn.cUnit ='/天' and " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec = gData.OpenResultset(cSql, rdOpenKeyset)
While Not cRec.EOF '显示选定日期
GroupNo = cRec(0)
c1 = cRec("dFrom_date")
c2 = cRec("dTo_Date")
Size = cRec("size")
Position = cRec("cPosition")
sType = cRec("cType")
price = cRec("iLargess_Invo")
fpSpr.SetText 5, M, Size
fpSpr.SetText 3, M, Position
fpSpr.SetText 4, M, sType
fpSpr.SetText 7, M, "天"
fpSpr.SetText k, M, price
fpSpr.SetText k + 1, M, price * T
cRec.MoveNext
Wend
Next
fpSpr.MaxCols = k + 5
fpSpr.MaxRows = M + 1
End Sub
Sub Intel()
fpSpr.Col = -1
fpSpr.Row = -1
fpSpr.Text = ""
fpSpr.BackColor = &HFFFFFF '无色
'
k = 10
pTags = Left(pTags, Len(pTags) - 0)
iTags = Split(pTags, ",")
M = 3
cSql = " select min(dFrom_date) as dMin,max(dTo_date) as dMax " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no in ( " & pTags & ") "
Set cRecT = gData.OpenResultset(cSql, rdOpenKeyset)
dtbegin = DateSerial(Year(cRecT("dMin")), Month(cRecT("dMin")), 1)
dtend = DateSerial(Year(cRecT("dMax")), Month(cRecT("dMax")) + 1, 1) - 1
For p = 10 To DateDiff("m", dtbegin, dtend) + 10 '日历头显示(月,星期,日)
fpSpr.Col = k
fpSpr.Row = 1
cMonth = Format(DateAdd("m", p - 10, dtbegin), "yyyy-mm-dd")
fpSpr.Text = fun(Format(cMonth, "mm"))
d1 = DateSerial(Year(cMonth), Month(cMonth), 1) ' 当月第一天
d2 = DateSerial(Year(cMonth), Month(cMonth) + 1, 1) - 1 '当月最后一天
For j = 10 To DateDiff("d", d1, d2) + 10
fpSpr.Col = k
fpSpr.Row = 3
fpSpr.Text = Format(DateAdd("d", j - 10, d1), "dd")
fpSpr.ColWidth(k) = 2
k = k + 1
Select Case Weekday(DateAdd("d", j - 10, d1))
Case 7:
fpSpr.Row = 2
fpSpr.Text = "六"
fpSpr.BackColor = &HC0C0FF
Case 1:
fpSpr.Row = 2
fpSpr.Text = "日"
fpSpr.BackColor = &HC0C0FF
Case 2:
fpSpr.Row = 2
fpSpr.Text = "一"
Case 3:
fpSpr.Row = 2
fpSpr.Text = "二"
Case 4:
fpSpr.Row = 2
fpSpr.Text = "三"
Case 5:
fpSpr.Row = 2
fpSpr.Text = "四"
Case 6:
fpSpr.Row = 2
fpSpr.Text = "五"
End Select
Next j
Next p
T = 0
fpSpr.MaxRows = UBound(iTags) + 4
For i = 0 To UBound(iTags)
iType = iTags(i)
cSql1 = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,n.iType_id " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec1 = gData.OpenResultset(cSql1, rdOpenKeyset)
While Not cRec1.EOF
newGroup_no = cRec1("iType_id")
If newGroup_no = oldGroup_no Then
If M = 3 Then
M = 4
End If
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 10 + var To DateDiff("d", c1, c2) + 10 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 10 - var, CDate(c1)), 1)
T = T + 1
Next a
Else
T = 0
M = M + 1
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 10 + var To DateDiff("d", c1, c2) + 10 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 10 - var, CDate(c1)), 1)
T = T + 1
Next a
End If
fpSpr.SetText k, M, T
oldGroup_no = cRec1("iType_id")
cRec1.MoveNext
Wend
cSql = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,nn.iLargess_Invo " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "inner join tbl_NetPrice_NoProduct nn on nn.cGroup_No = g.cGroup_No " _
& "where nn.cUnit ='/天' and " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec = gData.OpenResultset(cSql, rdOpenKeyset)
While Not cRec.EOF '显示选定日期
GroupNo = cRec(0)
c1 = cRec("dFrom_date")
c2 = cRec("dTo_Date")
Size = cRec("size")
Position = cRec("cPosition")
sType = cRec("cType")
price = cRec("iLargess_Invo")
fpSpr.SetText 3, M, Size
fpSpr.SetText 4, M, Position
fpSpr.SetText 5, M, sType
cRec.MoveNext
Wend
Next
fpSpr.MaxCols = k + 9
fpSpr.MaxRows = M + 1
End Sub
Sub IBM()
fpSpr.Col = -1
fpSpr.Row = -1
fpSpr.Text = ""
fpSpr.BackColor = &HFFFFFF '无色
'
k = 12
pTags = Left(pTags, Len(pTags) - 0)
iTags = Split(pTags, ",")
M = 3
cSql = " select min(dFrom_date) as dMin,max(dTo_date) as dMax " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no in ( " & pTags & ") "
Set cRecT = gData.OpenResultset(cSql, rdOpenKeyset)
dtbegin = DateSerial(Year(cRecT("dMin")), Month(cRecT("dMin")), 1)
dtend = DateSerial(Year(cRecT("dMax")), Month(cRecT("dMax")) + 1, 1) - 1
For p = 12 To DateDiff("m", dtbegin, dtend) + 12 '日历头显示(月,星期,日)
fpSpr.Col = k
fpSpr.Row = 1
cMonth = Format(DateAdd("m", p - 12, dtbegin), "yyyy-mm-dd")
fpSpr.Text = fun(Format(cMonth, "mm"))
d1 = DateSerial(Year(cMonth), Month(cMonth), 1) ' 当月第一天
d2 = DateSerial(Year(cMonth), Month(cMonth) + 1, 1) - 1 '当月最后一天
For j = 12 To DateDiff("d", d1, d2) + 12
fpSpr.Col = k
fpSpr.Row = 3
fpSpr.Text = Format(DateAdd("d", j - 12, d1), "dd")
fpSpr.ColWidth(k) = 2
k = k + 1
Select Case Weekday(DateAdd("d", j - 12, d1))
Case 7:
fpSpr.Row = 2
fpSpr.Text = "六"
fpSpr.BackColor = &HC0C0FF
Case 1:
fpSpr.Row = 2
fpSpr.Text = "日"
fpSpr.BackColor = &HC0C0FF
Case 2:
fpSpr.Row = 2
fpSpr.Text = "一"
Case 3:
fpSpr.Row = 2
fpSpr.Text = "二"
Case 4:
fpSpr.Row = 2
fpSpr.Text = "三"
Case 5:
fpSpr.Row = 2
fpSpr.Text = "四"
Case 6:
fpSpr.Row = 2
fpSpr.Text = "五"
End Select
Next j
Next p
T = 0
fpSpr.MaxRows = UBound(iTags) + 4
For i = 0 To UBound(iTags)
iType = iTags(i)
cSql1 = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,n.iType_id " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "where " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec1 = gData.OpenResultset(cSql1, rdOpenKeyset)
While Not cRec1.EOF
newGroup_no = cRec1("iType_id")
If newGroup_no = oldGroup_no Then
If M = 3 Then
M = 4
End If
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 12 + var To DateDiff("d", c1, c2) + 12 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 12 - var, CDate(c1)), 1)
T = T + 1
Next a
Else
T = 0
M = M + 1
c1 = cRec1("dFrom_date")
c2 = cRec1("dTo_Date")
var = DateDiff("d", dtbegin, c1)
var2 = DateDiff("d", dtbegin, c2)
For a = 12 + var To DateDiff("d", c1, c2) + 12 + var
fpSpr.Col = a
fpSpr.Row = M
fpSpr.BackColor = &HFF00&
fpSpr.Text = Format(DateAdd("d", a - 12 - var, CDate(c1)), 1)
T = T + 1
Next a
End If
fpSpr.SetText 8, M, T
oldGroup_no = cRec1("iType_id")
cRec1.MoveNext
Wend
cSql = " select g.cGroup_No,cast(g.iWidth as char(6))+'*'+cast(g.iHeight as char(6)) as size, " _
& "g.cPosition , r.dFrom_date, r.dTo_Date, n.cType,nn.iLargess_Invo " _
& " from tbl_NetPosition_Group g " _
& "inner join tbl_NetPosition n on N.cGroup_No=G.cGroup_No " _
& "inner join tbl_Register_Position r on R.iType_Id=N.iType_Id " _
& "inner join tbl_NetPrice_NoProduct nn on nn.cGroup_No = g.cGroup_No " _
& "where nn.cUnit ='/天' and " _
& "r.iReg_no = " & iType & " order by dFrom_Date,dTo_date"
Set cRec = gData.OpenResultset(cSql, rdOpenKeyset)
While Not cRec.EOF '显示选定日期
GroupNo = cRec(0)
c1 = cRec("dFrom_date")
c2 = cRec("dTo_Date")
Size = cRec("size")
Position = cRec("cPosition")
sType = cRec("cType")
price = cRec("iLargess_Invo")
fpSpr.SetText 5, M, Size
fpSpr.SetText 3, M, Position
fpSpr.SetText 2, M, sType
fpSpr.SetText 7, M, price
fpSpr.SetText 9, M, price * T
cRec.MoveNext
Wend
Next
fpSpr.MaxCols = k - 1
fpSpr.MaxRows = M + 1
End Sub
Private Sub Form_Load()
Dim dTags As String
'iTags = Split(pTags, ",")
End Sub
Function fun(sa As String) As String
Select Case sa
Case "01":
fun = "January"
Case "02":
fun = "February"
Case "03":
fun = "March"
Case "04":
fun = "April"
Case "05":
fun = "May"
Case "06":
fun = "June"
Case "07":
fun = "July"
Case "08":
fun = "August"
Case "09":
fun = "September"
Case "10":
fun = "October"
Case "11":
fun = "Noverber"
Case "12":
fun = "December"
End Select
End Function
Private Sub Form_Resize()
' If Me.WindowState = 1 Then Exit Sub
' i = Me.Width - 580
' If i <= 0 Then i = 1
' fpSpr.Width = i
'
' 'flexgrid 和 flexgridno 按照3：1显示
' i = Me.Height - 1500
' If i < 0 Then
' Else
' fpSpr.Height = i / 4 * 4
' fpSpr.Top = 1000
' i = Me.Height - fpSpr.Height - 1500
' If i > 0 Then
' fpSpr.Height = i
' End If
' End If
'当窗体移动时,设置fpSpr的大小及位置
'如果窗口状态为最小化,跳出过程
If Me.WindowState = 1 Then Exit Sub
With fpSpr
.Width = IIf(Me.Width - 300 > 1, Me.Width - 300, 10)
.Height = IIf(Me.Height - 1600 > 1, Me.Height - 1600, 10)
End With
End Sub
根据模版生成的窗体
由于生成窗体太宽，所以分两部分显示，上面是左边，下面是右边
