Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-窗体/数据页

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

'????????????????????????????????????
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
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

Exit Sub
cuowu1:
ReDim CC(1)
Resume Next
cuowu:
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
N = Frmt.name
For JJ = LBound(CC) To UBound(CC)
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
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
Exit Sub
cuowu:
MsgBox Err.Description
Exit Sub
End Sub


Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助