Access 控件自适应分辨率
时 间:2019-11-25 18:15:14
作 者:蒋东林 ID:72854 城市:重庆
摘 要:access 控件自适应 vba代码
原作者:loooooo
修改: auqaiss
正 文:
原作者:loooooo
修改: auqaiss
Option Compare Database
Type JLtype '????????????
Tn As String '?????
T1 As Integer '?????????
L1 As Integer '?????????
W1 As Integer '??????
H1 As Integer '??????
End Type
Type CTS '????????????
Cn As String '??????
OLDW As Integer '????????
OLDH As Integer '????????
TZzz() As JLtype '????????????????
i As Integer '?????????????????
End Type
Public CC() As CTS '???????????飨??????????????????棩
Public Sub TZLoad(Frm As Form)
'--------------------------
On Error GoTo cuowu1
Dim Cw As Long '??鴰????±???????δ???????
Cw = UBound(CC)
'----------------------------
'On Error GoTo cuowu
Dim N As String
Dim JJ As Integer
Dim PD As Boolean
'?????????????壬??????????????
N = Frm.name
For JJ = LBound(CC) To UBound(CC)
If CC(JJ).Cn = N Then
PD = True
Exit For
Else
PD = False
End If
Next JJ
If PD = False Then
JJ = JJ + 1
ReDim Preserve CC(JJ)
End If
JJ = JJ + 1
ReDim Preserve CC(JJ)
End If
'????????????????????????????????????
CC(JJ).Cn = N
CC(JJ).OLDH = Frm.InsideHeight
CC(JJ).OLDW = Frm.InsideWidth
CC(JJ).i = 0 '????????????????
Dim obj As Control
Dim L As Integer
Dim L As Integer
For Each obj In Frm
CC(JJ).i = CC(JJ).i + 1
L = CC(JJ).i
ReDim Preserve CC(JJ).TZzz(L)
CC(JJ).TZzz(L).Tn = obj.name
CC(JJ).TZzz(L).T1 = obj.Top
CC(JJ).TZzz(L).L1 = obj.Left
CC(JJ).TZzz(L).W1 = obj.Width
CC(JJ).TZzz(L).H1 = obj.Height
Next obj
CC(JJ).i = CC(JJ).i + 1
L = CC(JJ).i
ReDim Preserve CC(JJ).TZzz(L)
CC(JJ).TZzz(L).Tn = obj.name
CC(JJ).TZzz(L).T1 = obj.Top
CC(JJ).TZzz(L).L1 = obj.Left
CC(JJ).TZzz(L).W1 = obj.Width
CC(JJ).TZzz(L).H1 = obj.Height
Next obj
Exit Sub
cuowu1:
ReDim CC(1)
Resume Next
ReDim CC(1)
Resume Next
cuowu:
MsgBox Err.Description
Exit Sub
MsgBox Err.Description
Exit Sub
End Sub
Public Sub TZsize(Frmt As Form)
'On Error GoTo cuowu
Dim N As String
Dim X As Double
Dim Y As Double
Dim j As Integer
Dim JJ As Integer
Dim X As Double
Dim Y As Double
Dim j As Integer
Dim JJ As Integer
N = Frmt.name
For JJ = LBound(CC) To UBound(CC)
If CC(JJ).Cn = N Then Exit For
Next JJ
If CC(JJ).Cn = N Then Exit For
Next JJ
Dim obj As Control
Y = Frmt.InsideHeight / CC(JJ).OLDH
X = Frmt.InsideWidth / CC(JJ).OLDW
X = Frmt.InsideWidth / CC(JJ).OLDW
Frmt.Section(acDetail).Height = Frmt.InsideHeight '????????,?????????
For j = 1 To CC(JJ).i
Set obj = Frmt(CC(JJ).TZzz(j).Tn)
'if obj.Name="
With obj
If Len(.name) < 16 or Left(.name, 16) <> "NavigationButton" Then '原来作者这里没有判断是否是NavigationButton,导致一旦对其.top .left属性赋值就会报错
.Top = CC(JJ).TZzz(j).T1 * 1.1
.Left = CC(JJ).TZzz(j).L1 * X
End If
.Width = CC(JJ).TZzz(j).W1 * X
.Height = CC(JJ).TZzz(j).H1 * Y
End With
Next j
Set obj = Frmt(CC(JJ).TZzz(j).Tn)
'if obj.Name="
With obj
If Len(.name) < 16 or Left(.name, 16) <> "NavigationButton" Then '原来作者这里没有判断是否是NavigationButton,导致一旦对其.top .left属性赋值就会报错
.Top = CC(JJ).TZzz(j).T1 * 1.1
.Left = CC(JJ).TZzz(j).L1 * X
End If
.Width = CC(JJ).TZzz(j).W1 * X
.Height = CC(JJ).TZzz(j).H1 * Y
End With
Next j
Exit Sub
cuowu:
MsgBox Err.Description
Exit Sub
MsgBox Err.Description
Exit Sub
End Sub
Access软件网QQ交流群 (群号:483923997) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access窗体导出PDF】...(04.08)
- 【Access窗体导出PDF】...(04.07)
- Access两种方式实现即时更...(03.01)
- Access隐藏与显示lacc...(01.12)
- 【Access高效办公】将每个...(12.23)
- Access21点游戏源代码(12.13)
- 【Access窗体导出Exce...(11.15)
- 【Access开发】Acces...(11.14)
- 通过Access宏录入数据到选...(11.10)
学习心得
最新文章
- 【Access表名称命名建议】将A...(04.20)
- Access学习笔记--用Acce...(04.19)
- 【Access重复项查询示例】将A...(04.17)
- Access快速开发平台企业版--...(04.16)
- 【Access模块示例】通过模块代...(04.15)
- Access查询里面分组合计功能添...(04.13)
- 【Access删除查询】删除数字最...(04.12)
- 显示文件夹中所有文件的修改时间(04.11)
- 铁路工程管理系统;铁路工程管理小程...(04.10)
- 【Access查询示例】怎么将两个...(04.09)