连续子窗体列宽调整

我对这个真是佩服到五体投地,真是牛逼到不行,这个代码严重解决了连续窗体不能拉大拉小的问题.厉害至极啊!

原文链接:http://www.accessoft.com/article-show.asp?id=4686

但是经过测试发现,有异常,关键原因出在控件在窗体里面的排序

解决方法就是重新按照需要的顺序,重新添加标签

Dim x0 As Single Dim ctlname As String Private Sub ctlWidth(frm As Form, X) Dim ctls As Controls Dim v As Single Set ctls = frm.Controls v = ctls(ctlname & "_Label").Width + X - x0 If v > 0 Then     ctls(ctlname & "_Label").Width = v     ctls(ctlname).Width = v     Call ctlMove(Me.Form, X)     x0 = X End If End Sub Private Sub ctlMove(frm As Form, X) Dim ctls As Controls Dim i As Long, m As Long Dim v As Single Set ctls = frm.Controls v = X - x0 For i = 0 To frm.Section(acHeader).Controls.Count - 1     If ctls(i).Caption = ctlname Then         m = i         Exit For     End If Next For i = m + 1 To frm.Section(acHeader).Controls.Count - 1     ctls(i).Left = ctls(i).Left + v     ctls(ctls(i).Caption).Left = ctls(i).Left + v Next End Sub Private Sub id_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)     On Error GoTo ErrorHandler     x0 = X     ctlname = "id" ExitHere:     Exit Sub ErrorHandler:     RDPErrorHandler Me.Name & ": Sub Form_Load()"     Resume ExitHere End Sub Private Sub id_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error GoTo ErrorHandler If Button = acLeftButton Then     Call ctlWidth(Me.Form, X) End If ExitHere:     Exit Sub ErrorHandler:     RDPErrorHandler Me.Name & ": Sub Form_Load()"     Resume ExitHere End Sub

【access小品】连续子窗体列宽调整

来源:原创   点击数:6229   评论数:2　 评论 | 收藏 | 复制

时　间:2010-07-10 06:56:16
作　者:todaynew   ID：10802  城市：武汉
摘　要:连续窗体列宽调整
正　文:

　　昨日里写了一个数据表子窗体列宽锁定实例，并留下了一个连续表子窗体列宽调整问题。想了想既然提出了问题，总归要解决问题才对，于是乎便写就如下实例。

点击下载此附件

Option Compare Database

Option Explicit
Dim x0 As Single
Dim ctlname As String


Private Sub ctlWidth(frm As Form, X)
Dim ctls As Controls
Dim v As Single
Set ctls = frm.Controls
v = ctls(ctlname & "_Label").Width + X - x0
If v > 0 Then
    ctls(ctlname & "_Label").Width = v
    ctls(ctlname).Width = v
    Call ctlMove(Me.Form, X)
    x0 = X
End If
End Sub


Private Sub ctlMove(frm As Form, X)
Dim ctls As Controls
Dim i As Long, m As Long
Dim v As Single
Set ctls = frm.Controls
v = X - x0
For i = 0 To frm.Section(acHeader).Controls.Count - 1
    If ctls(i).Caption = ctlname Then
        m = i
        Exit For
    End If
Next
For i = m + 1 To frm.Section(acHeader).Controls.Count - 1
    ctls(i).Left = ctls(i).Left + v
    ctls(ctls(i).Caption).Left = ctls(i).Left + v
Next
End Sub


Private Sub 标准价_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "标准价"
End Sub


Private Sub 标准价_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 成本价_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "成本价"
End Sub


Private Sub 成本价_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 规格型号_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "规格型号"
End Sub


Private Sub 规格型号_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 计量单位_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "计量单位"
End Sub


Private Sub 计量单位_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 年度_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "年度"
End Sub


Private Sub 年度_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 数量_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "数量"
End Sub


Private Sub 数量_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 物资编号_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "物资编号"
End Sub


Private Sub 物资编号_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 物资名称_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "物资名称"
End Sub


Private Sub 物资名称_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 销售价_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "销售价"
End Sub


Private Sub 销售价_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub


Private Sub 月度_Label_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
ctlname = "月度"
End Sub


Private Sub 月度_Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
    Call ctlWidth(Me.Form, X)
End If
End Sub