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

原文链接: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小品】连续子窗体列宽调整

时 间: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

相关文章:

  • 2022-12-23
  • 2021-12-24
  • 2021-10-26
  • 2022-12-23
  • 2021-08-08
  • 2022-12-23
  • 2022-12-23
  • 2021-08-06
猜你喜欢
  • 2022-12-23
  • 2022-12-23
  • 2022-12-23
  • 2022-12-23
  • 2021-10-30
  • 2022-12-23
  • 2022-12-23
相关资源
相似解决方案