盟威Access快速开发平台非常实用，我们需要更多普及使用方法。本文适合初学者学习。
附件占用的显示区域大，如果能折叠起来可以改善窗体的美观，使用心得仅供大家参考，不周全之处大家谅解。
附件详细使用说明见我此前的文章说明：
http://www.accessoft.com/blog/article-show.asp?userid=72228&Id=20190
================================================================
有人会问直接用InsideWidth不是具备展开区域目的，为什么要搞二个定位在窗体里？
每个窗体有大有小，打开时需要居中显示如果设置好定位的存在调试时更快捷方便。
定位也可以进行二次扩展，具体就不详细说明。
扩展区域的作用：
1》存放隐藏核心参数或者展示附件详细，配备权限时有保密作用
2》主要和次要内容分开显示，【简化窗体】，让参数较多的窗体不臃肿。
==============================================================
扩展区域和折叠功能实现步骤如下:
1》首先设置二个变量
Private gTMPInsideWidth As Long
Private showAll As Boolean
2》在原区域和扩展之后的区域设置定位的目标
cmd5_More 是箭头的控键
Text5 是一个扩展之后的定位作用的文本框控键【定位最远箭头的位置作用】 【使用时最好设置不可见，最小化】
以上二个建议使用时数字编号是一对，在使用时头绪不会紊乱
任意一个在窗体下端的控键或者文本框 收缩显示区域的定位目标。
3》注意事项：
1】如果多个窗体使用折叠扩展显示区域时 箭头控键和文本定位不能使用一个固定的名称，
否则只有第一次使用的窗体正常使用，其他窗体无法使用。【初学者留意】
设计时最好统一分配好数字编号，防止系统紊乱。
2】窗体大小显示不同，收缩的范围不同，定位的箭头有不同，注意自己了解那个是定位的位置
+是向右移动 -是向左移动 【也能实现2次折叠显示】
3】如果收缩之后不合适，系统将无法显示 会变成一个很窄的小窗体只能看到一个“×”
点这个窄窗体上边的“×”才能退出死循环
4》代码如下
Option Compare Database
Option Explicit
'====================折叠功能专用=======================================
Private showAll As Boolean '申明一个扩展区域的变量专用
Private gTMPInsideWidth As Long '申明一个扩展区域的变量专用
Public Function InitData()
ClearControlValues Me
CurrentDb.Execute "Delete FROM [TMP_纹纸仪匠_次]"
'===============附件功能专用=====================
Call Me.sfrAttachments.Form.LoadAttachmentData("纹纸图", Me!纹纸图)
'===============附件功能专用====================
Me.sfrDetail.Requery
End Function
Private Sub Form_Load()
If CanViewVBACode() Then
On Error GoTo 0
Else
On Error GoTo ErrorHandler
End If
ApplyTheme Me
LoadLocalLanguage Me
'------------------------
Dim cnn As Object '【附件添加的代码】【申明CNN】
Set cnn = CurrentProject.Connection '【附件添加的代码】【设置CNN】
Me.InitData
If Nz(Me.OpenArgs) <> "" Then
LoadRecord Me, "Select * FROM [纹纸仪匠_主] Where [ID]=" & Nz(Me.OpenArgs, 0)
LoadRecord "TMP_纹纸仪匠_次", "Select * FROM [纹纸仪匠_次] Where [纹纸代码]=" & SQLText(Me![纹纸代码])
End If
'加载附件时，只能放在这里，否则保存时报警
Call Me.sfrAttachments.Form.LoadAttachmentData("纹纸图", Me!纹纸图) '附件添加的【加载作用】代码 “纹纸图”是保存的时候前缀名称
If Me.DataEntry Then
Me![ID] = Null
Me![纹纸代码] = Null
End If
Me.sfrDetail.Requery
Me.btnSave.Enabled = Me.AllowEdits
'==============================
If Me.审核状态 = "已审核" Then '当审核状态=已审核时
Me.AllowEdits = False '窗体的所有编辑功能=关闭
Me.btnSave.Enabled = False '窗体的保存功能=关闭
Me.sfrDetail.Enabled = False '窗体的子窗体编辑功能=关闭
End If '退出假设
'=================================
ExitHere:
Exit Sub
ErrorHandler:
MsgBoxEx Err.Description, vbCritical
Resume ExitHere
End Sub
Private Sub btnSave_Click()
If CanViewVBACode() Then
On Error GoTo 0
Else
On Error GoTo ErrorHandler
End If
If Not CheckRequired(Me) Then Exit Sub
If Not CheckTextLength(Me) Then Exit Sub
If Not CheckRequired(Me.sfrDetail) Then Exit Sub
Dim cnn: Set cnn = CurrentProject.Connection 'ADO.Connection()
cnn.BeginTrans
Dim blnTransBegin As Boolean: blnTransBegin = True
If Nz(Me![纹纸代码]) = "" Then Me![纹纸代码] = GetAutoNumber("纹纸代码")
Dim strSQL: strSQL = "Select * FROM [纹纸仪匠_主] Where [ID]=" & Nz(Me![ID], 0)
Dim rst: Set rst = ADO.OpenRecordset(strSQL, adLockOptimistic, cnn)
If rst.EOF Then rst.AddNew
UpdateRecord Me, rst
'你的自定义代码
'rst!Field1 = Me!Field1
'rst!Field2 = Me!Field2
rst.Update
rst.Close
cnn.Execute "Delete FROM [纹纸仪匠_次] Where [纹纸代码]=" & SQLText(Me![纹纸代码])
strSQL = "Select * FROM [纹纸仪匠_次] Where [纹纸代码]=" & SQLText(Me![纹纸代码])
Set rst = ADO.OpenRecordset(strSQL, adLockOptimistic, cnn)
Dim rstTmp: Set rstTmp = CurrentDb.OpenRecordset("TMP_纹纸仪匠_次")
Do Until rstTmp.EOF
rst.AddNew
UpdateRecord rstTmp, rst
'你的自定义代码
'rst!Field1 = Me!Field1
'rst!Field2 = Me!Field2
rst![纹纸代码] = Me![纹纸代码]
rst.Update
rstTmp.MoveNext
Loop
rst.Close
rstTmp.Close
cnn.CommitTrans
blnTransBegin = False
RequeryDataObject gsfrList
MsgBoxEx LoadString("Saved Successfully."), vbInformation
'加载保存附件时，必须放在保存之后，否则保存时出错
Call Me.sfrAttachments.Form.SaveAttachmentData("纹纸图", Me!纹纸图) '【附件添加的保存代码】
If Me.DataEntry Then
Me.InitData
Else
DoCmd.Close acForm, Me.Name, acSaveNo
End If
ExitHere:
Set rst = Nothing
Set cnn = Nothing
Set rstTmp = Nothing
Exit Sub
ErrorHandler:
If blnTransBegin Then
cnn.RollbackTrans
blnTransBegin = False
End If
MsgBoxEx Err.Description, vbCritical
Resume ExitHere
End Sub
Private Sub btnCancel_Click()
On Error Resume Next
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub 停用_Click()
If Me.停用 = -1 Then '当停用为假时
MsgBox "你确定要【停用】此数据吗？" & vbNewLine & "系统将【不会采用】本数据！" & vbNewLine & "请慎重选择！", vbExclamation + vbOKOnly '警告提示 +允许确认
Else
MsgBox "你确定要【启用】此数据吗？" & vbNewLine & "系统将【使用】本数据！" & vbNewLine & "请慎重选择！", vbExclamation + vbOKOnly '警告提示 +允许确认
End If
End Sub
Private Sub cmd5_More_Click()
If showAll = True Then
Me.InsideWidth = Me.Text5.Width + Me.InsideWidth + Me.cmd5_More.Width + 6200 '最大布局的最大宽上放CMD_click的地方
Me.cmd5_More.Left = Me.Text5.Left + 250 'CMD_click的左边位置 在那个按键的地方距离
Me.cmd5_More.Picture = CurrentProject.Path & "\Images\icons\db previous.ico"
showAll = False
Else
Me.InsideWidth = gTMPInsideWidth
Me.cmd5_More.Picture = CurrentProject.Path & "\Images\icons\db next.ico"
Me.cmd5_More.Left = Me.纹纸图.Left + 11050 'CMD_click的 【新箭头的右边】距离位置 在纹纸图的左侧+11050的位置
showAll = True
End If
End Sub
Private Sub Form_Open(Cancel As Integer)
showAll = True
Me.cmd5_More.Picture = CurrentProject.Path & "\Images\icons\db next.ico"
'隐藏计算部分，并让窗体居中。
Me.InsideWidth = Me.cmd5_More.Left + Me.cmd5_More.Width + 20 '设置显示时窗体的边界在那里
gTMPInsideWidth = Me.InsideWidth
Move Me.WindowLeft + Me.纹纸图.Width - 200 '当窗体不居中时，把窗体向左平移200个单位
End Sub
5》示例下载:
点击下载此示例附件
6》图示效果:
