Access交流网
  • 设为首页|收藏本站|繁体中文|手机版
  •     
  • Access培训-Access开发平台-Access行业开发

  • 首页
  • 资讯
  • 技巧
  • 源码
  • 行业
  • 资源
  • 活动
  • 关于

技巧

ACCESS数据库

启动/设置/选项/背景

修复/压缩

安全/加密/解密

快捷键

版本升级/其它等

数据表

命名方式/设计规范

表设计

查询

Sql语言基础

选择查询

更新查询

删除查询

追加查询

生成表查询

交叉表查询

SQL特定查询

查询参数

查询综合应用

界面/窗体/控件

标签

文本框

命令按钮

组合框/列表框

选项组/复选框/选项按钮

选项卡

子窗体

窗体本身/综合应用

其它

报表打印

报表设计

高级报表

模块/函数/VBA/API/系统

VBA基础

内置函数

调试/跟踪/Debug

模块/类模块

API/COM/系统相关

字符数字日期

网络通信游戏

加密解密安全

文件处理

经典算法

宏/菜单/工具栏/功能区

宏/脚本

菜单/工具栏

功能区/Ribbon

图表/图形/图像/多媒体

图表

图形/图像

音频

视频/动画

DAO/链接表/ADO/ADP

DAO/链接表/ODBC

ADO/RDO

ADP

ActiveX/第三方控件/插件

Treeview树控件

ListView列表控件

Toolbar工具栏控件

微软其它控件

Dbi-Tech

CodeJock

Grid++Report

FastReport

ComponentOne

加载项/插件/Addin

OFFICE集成/导入导出/交互

Excel导入导出/交互

Word导入导出/交互

PPT交互

Outlook控制/邮件

Text文本文件/INI/CSV

PDF/SWF/XML格式

CAD格式

Sharepoint/其它Office

SqlServer/其它数据库

表

视图

存储过程/触发器

函数

用户/权限/安全

调试/维护

SqlServer其它/综合

发布/打包/文档/帮助

开发版/运行时

打包/发布/部署

开发文档/帮助制作

Access完整行业系统

采购管理系统

销售管理系统

仓库管理系统

人力资源管理HRM

CRM管理系统

MRP/ERP管理系统

BRP/流程优化

其它管理系统

心得/经验/绝招
其它/杂项
Excel技巧

Excel应用与操作

Excel开发编程

Word技巧

Word应用与操作

Word开发编程

Outlook技巧

Outlook应用与操作

Outlook开发编程

热门文章

  • 如何在OFFICE各软件保..
  • 在系统退出的时侯把操作时所..
  • access vba 数据..
  • 判断生日到期天数的函数Ac..
  • Sum()和Dsum()的..
  • Access完成累计余额的..

最新文章

  • Access或VB VBA..
  • 关于VBA的0、""(空字..
  • Access导出函数Out..
  • Access日期与日期区间..
  • RecordSource ..
  • Access子窗体事件控制..

联系方式

Access交流网(免费Access交流)

QQ:18449932 

网  址:www.access-cn.com

当前位置:首页 > 技巧 > 模块/函数/VBA/API/系统 > VBA基础
VBA基础

ACCESS-VBA编程 第九章 VBA使用技巧2

让控件自适应屏幕分辨率2
'这个函数可以使你开发的程序适应各种分辨率,这是我见过的最完美的解决方案!强列推荐
''如果你是在1024*768的分辨率下写的程序,就把下面那句改为
Const DesignSize = 1024,如果是800*600分
'辨率下写的,就改为Const DesignSize = 800
'用法:把下面所有的代码放在一个模块里,在需要适应分辨率的窗体的Load事
'件里加入Call FormResiz_OnOpen(Me)
'
'Const DesignSize = 1024
Const DesignSize = 800
'☆★☆★☆★☆★☆★☆★☆★☆★☆★
'API宣言
Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
'Type宣言
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
'国标码宣言
Dim frm As Form
Dim ctrl As Control
Dim prp As Property
Dim rat As Double
Dim flgSec
Dim X As Long
Dim WinHeight As Long
Dim hWnd As Long
Dim ret As Long
Dim i As Integer
Dim R As RECT
Dim SizeL As Long
Dim SizeT As Long
Dim SizeW As Long
Dim SizeH As Long
'--------------------------------------------------------------------------------
Public Function FormResiz_OnOpen(parFrm As Form, Optional perSizeL As Long, Optional perSizeT As Long, Optional perSizeW As Long, Optional perSizeH As Long)
On Error Resume Next
Set frm = parFrm
'窗口驾驶盘的取得
hWnd = GetDesktopWindow()
'现在分辨率取得
ret = GetWindowRect(hWnd, R)
'比例计算 常例:现在800 开发1024 800/1024 = 0.78加倍
X = (R.x2 - R.x1)
rat = X / DesignSize
SizeL = 0: SizeT = 0: SizeW = 0: SizeH = 0
If Not IsEmpty(perSizeL) = True Then
SizeL = perSizeL * rat
SizeT = perSizeT * rat
SizeW = perSizeW * rat
SizeH = perSizeH * rat
End If
'现在分辨率=开发分辨率如果终了
If X = DesignSize Then Exit Function
If X < DesignSize Then
'细小策划时、控制>部分>表单的次序
Call ChangeCtrl
Call ChengeSec
Call ChangeFrm
Else
'大掬取时、表单>部分>控制的次序
Call ChangeFrm
Call ChengeSec
Call ChangeCtrl
End If
'最后、表单的使清新
frm.Refresh
Exit Function
End Function
'--------------------------------------------------------------------------------
Private Sub ChangeCtrl()
On Error Resume Next
'控制转
For Each ctrl In frm.Controls
'*******************************************************************
'选项卡修正,原著没有这段代码,后来有个朋友发现了这个BUG,就是选项卡的位置会偏得很厉害
'所以就加了这段代码来修正
'主要是"Top", "Height","Left","Width"这几个参数的值,根据实际情况适当调整就行了
If ctrl.ControlType = 123 or ctrl.ControlType = 124 Then
For Each prp In ctrl.Properties
Select Case prp.Name
Case "FontSize", "DatasheetFontHeight"
prp.value = Fix(prp.value * rat + 0.5)
Case "FontWeight"
prp.value = Fix((prp.value * rat) / 100) * 100
Case "Top", "Height"
prp.value = Fix(prp.value * rat * 0.85)
'prp.value = Fix(prp.value * rat)
Case "Left"
prp.value = Fix(prp.value * rat * 0.9)
Case "Width"
prp.value = Fix(prp.value * rat * 0.7)
End Select
Next prp
'*******************************************************************************
Else
'属性转
For Each prp In ctrl.Properties
'大小·配置关于属性被发现们压缩
Select Case prp.Name
Case "FontSize", "DatasheetFontHeight"
'通常计算假如行…情况之下的 +0.5 之类的话不需要是…但…、
'捆Zo~Ma办法。稍微心情坏因为 +0.5
prp.value = Fix(prp.value * rat + 0.5)
Case "FontWeight"
prp.value = Fix((prp.value * rat) / 100) * 100
Case "Left", "Top", "Width", "Height"
prp.value = Fix(prp.value * rat)
End Select
Next prp
End If
Next ctrl
End Sub
'--------------------------------------------------------------------------------
Private Sub ChengeSec()
On Error GoTo Err_Disp
'部分转
flgSec = True
i = 0
'不存在部分的参照错误化验出终了
Do Until flgSec = False
'部分被发现们高度变更
frm.Section(i).Height = Fix(frm.Section(i).Height * rat)
i = i + 1
Loop
Exit Sub
Err_Disp:
If Err = 2462 Then
flgSec = False
Resume Next
Else
MsgBox Err.Description
End If
Resume Next
End Sub
'--------------------------------------------------------------------------------
Private Sub ChangeFrm()
On Error Resume Next
'表单的大小变更
'Optional参数数值渡下次收拾ば、而且使合(计算正在完毕)
If SizeL > 0 Then
DoCmd.MoveSize SizeL, SizeT, SizeW, SizeH
Else
'特别是指定啊假如踢、变更了表单的大小表示
'表单的属性(宽与高度)
frm.Width = Fix(frm.Width * rat)
WinHeight = Fix(frm.WindowHeight * rat)
DoCmd.MoveSize , , frm.Width, WinHeight
End If
End Sub

用VBA赋应用程序图标
见测试窗体
Toolbar 控件使用
本例在一个Toolbar控件中添加五个 Button 对象,并且向每个 Button 对象添加二个 ButtonMenu 对象。单击ButtonMenu对象时,其行为由ButtonMenuClick事件来决定。为了试验本例,在窗体中放置一个 Toolbar 控件,将代码粘贴到代码模块的声明部分。
Option Explicit
Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As ComctlLib.ButtonMenu)
Select Case ButtonMenu.Index
Case 1
MsgBox "Press the button."
Case 2
MsgBox "Offer some option"
End Select
End Sub
' 窗体加载事件:
Private Sub Form_Load()
Dim i As Integer
Dim btn As Button
' 添加五个 Button 对象到 Toolbar 控件。
Set btn = Toolbar1.Buttons.Add(Caption:= i, Style:= tbrDropDown)
' 添加两个 ButtonMenu 对象到每一个Button。
btn.ButtonMenus.Add Text:="Help"
btn.ButtonMenus.Add Text:="Options"
Next i
End Sub

发布人:网络文章  
分享到:
点击次数:  更新时间:2009-02-27 14:01:03  【打印此页】  【关闭】
上一条:ACCESS-VBA编程 第九章 VBA使用技巧3  下一条:ACCESS-VBA编程 第九章 VBA使用技巧1



相关文章

  • • Access或VB VBA判断数组的值是否为空的几种方法
  • • 关于VBA的0、""(空字符串)、Null、Empty、与 Nothing 的区别
  • • Access导出函数OutPutto解释
  • • Access日期与日期区间的筛选
  • • RecordSource SourceObject ControlSource属性的区别
  • • Access子窗体事件控制父窗体
  • • 事件​change和AfterUpdate的区别
  • • 代码修改完善方法示例(初学者必读)

热门文章

  • [2009-05-11] VBA语句集400句(七部分)access数据库
  • [2017-08-02] 关于VBA的0、""(空字符串)、Null、Empty、与 Nothing 的区别access数据库
  • [2005-08-16] 初识VBA:第五课 小数点按钮及分支语句access数据库
  • [2013-11-11] Function与Sub的异同(函数调用)access数据库
  • [2009-04-11] 求和时出现"# 错误"字样如何解决?access数据库
  • [2013-10-19] Access中EXIT Sub与End Sub的区别access数据库

热门产品

公司动态|在线留言|在线反馈|友情链接|会员中心|站内搜索|网站地图

Access交流网 版权所有 1999-2018 粤ICP备10043721号

QQ:18449932

Access应用 Access培训 Access开发 Access平台

access|数据库|access下载|access教程|access视频|access软件

Powered by MetInfo 5.3.12 ©2008-2023  www.metinfo.cn