VBA实战(Excel)(4):实用功能整理

 1.后台打开Excel

       用于查数据,工作中要打开多个表获取数据再关闭的场景,利用此函数可以将excel表格作为后台数据库查询,快速实现客户要求,缺点是运行效率不够高。

Sub openexcel(exl_name As String)If Dir(addr, 16) = Empty Thenfile_error = TrueExit SubEnd IfSet fso = CreateObject("Scripting.FileSystemObject").GetFolder(addr & "\")file_name = ""For Each file In fso.FilesIf InStr(file.Name, exl_name & ".") > 0 And exl_name <> "" And InStr(file.Name, "$") < 1 Thenfile_name = file.Name 'fso.path'Debug.Print file.NameEnd IfNextSet fso = NothingIf InStr(file_name, "xlsm") > 0 And InStr(file_name, "蝶阀") > 0 Thenvba_s = TrueElsevba_s = FalseEnd IfIf file_name <> "" Thenstr_path = addr & "\" & file_name'Debug.Print str_pathIf IsWbOpen1(str_path) Then '判断excel是否已经打开ElseSet wb = GetObject(str_path)Application.Windows(wb.Name).Visible = Falsefind_if_open = TrueEnd IfElseMsgBox "报错:工作区中不存在该文件"file_error = TrueExit SubEnd If

 2.判断文件是否已打开

  避免重复打开客户已经打开的文件,提升体验和效率

Function IsWbOpen1(strPath As String) As Boolean'如果目标工作簿已打开则返回TRUE,否则返回FALSEDim oi As IntegerFor oi = Workbooks.Count To 1 Step -1If Workbooks(oi).FullName = strPath Then Exit ForNextIf oi = 0 ThenIsWbOpen1 = FalseElseIsWbOpen1 = TrueEnd If
End Function

3.生成新Excel

针对需要把结果生成一张新表格的客户

Public Sub export_excel(control As Office.IRibbonControl)Dim sourceWorkbook As WorkbookDim targetWorkbook As WorkbookDim sourceSheet As WorksheetDim newFileName As Stringshtn = Sheets("参数").Cells(2, 2)' 设置源工作簿和工作表Set sourceWorkbook = ThisWorkbook ' 当前工作簿Set sourceSheet = sourceWorkbook.Sheets("扭矩查询") ' 要导出的工作表名称' 创建新的工作簿Set targetWorkbook = Workbooks.Add' 拷贝工作表到新工作簿sourceSheet.Copy before:=targetWorkbook.Sheets(1)' 设置新工作簿的文件名newFileName = shtn & "factory-" & Format(Now(), "YYYYMMDDhhmmss") & ".xlsx" ' 新文件名' 保存新工作簿With targetWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & newFileName, FileFormat:=xlOpenXMLWorkbook.Close SaveChanges:=FalseEnd With' 清理Set sourceSheet = NothingSet targetWorkbook = NothingSet sourceWorkbook = Nothing
End Sub

4.延时

针对需要等待的场景,比如等待加载

Public Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
'------------延时------------
Sub delay1(T As Single) '秒级的延时Dim time1 As Singletime1 = TimerDoDoEventsLoop While Timer - time1 < T
End SubSub delay(T As Single) '毫秒级的延时(需要引用dll)Dim time1 As Singletime1 = timeGetTimeDoDoEventsLoop While timeGetTime - time1 < T
End Sub
'------------延时------------

5.链接Access数据库

Sub ExportDataToAccess(arrFileds As Variant, datas As Variant, sheetName As String)Dim conString$, sqlString$Dim cnn, rstSet cnn = CreateObject("ADODB.Connection")  ' 创建连接对象Set rst = CreateObject("ADODB.Recordset")   ' 创建记录集对象conString = "provider=Microsoft.ace.OLEDB.12.0;Data Source=" & ThisWorkbook.path _& "\test.accdb;"cnn.Open conString  ' 连接Access数据库rst.Open "select * from " & sheetName & " where 1=2", cnn, adOpenDynamic, _adLockOptimisticrst.AddNew arrFileds, datas     '数组插入到Accesscnn.Close   ' 关闭连接对象
End Sub

6.调节图片长宽比

此函数能调节插入图片的长宽比,通过等边距裁剪,使图片在Excel中排版统一

'--------------------------调整图片长宽比---------------------------
Sub change_sacle(shp As Shape, scal As Double) 'scale为长宽比,推荐值1.5If shp.Type = 13 Then '当shape对象类型是图片的时候,才开始统计(图片的值13)Dim xCrop As Object, xl As Double, xt As Doubleshp.ScaleHeight 0.995, msoTrue, msoScaleFromTopLeftshp.ScaleWidth 1.05, msoTrue, msoScaleFromTopLeftshp.PictureFormat.Crop.PictureOffsetX = 0shp.PictureFormat.Crop.PictureOffsetY = 0shp.PictureFormat.Crop.ShapeWidth = shp.PictureFormat.Crop.PictureWidthshp.PictureFormat.Crop.ShapeHeight = shp.PictureFormat.Crop.PictureHeightIf shp.Width / shp.Height - scal > 0.05 Or scal - shp.Width / shp.Height > 0.05 Then '允许一些误差防止无限裁剪
'                    Debug.Print "执行"If shp.Width / shp.Height > scal Then '宽了,裁剪左右xl = (shp.Width - shp.Height * scal) / 2'Debug.Print xlSet xCrop = shp.PictureFormat.Crop '返回一个Crop对象With xCrop '设置裁剪格式'.ShapeLeft = shp.Left + xl '裁剪左边.ShapeWidth = .PictureWidth - 2 * xl '裁剪宽度.PictureOffsetX = 0.PictureOffsetY = 0End WithElse '高了,裁剪上下xt = (shp.Height - shp.Width / scal) / 2'Debug.Print xt
'                    Debug.Print "高了"Set xCrop = shp.PictureFormat.Crop '返回一个Crop对象With xCrop '设置裁剪格式'.ShapeTop = shp.Top + xt '裁剪顶部.ShapeHeight = .PictureHeight - 2 * xt '裁剪高度.PictureOffsetX = 0.PictureOffsetY = 0End WithEnd IfEnd IfEnd If
End Sub
'--------------------------调整图片长宽比---------------------------

7.获取一段函数的运行时间

'------------获取一段函数运行时间------------
Sub GetRunTime()Dim i As LongDim dteStart As DateDim strTime As String'Application.ScreenUpdating = False'关闭屏幕刷新dteStart = Timer'---------运行过程主体-------
MkDir "D:\Bomad\Assembly"'---------运行过程主体-------strTime = Format((Timer - dteStart), "0.00000")MsgBox "运行过程: " & strTime & "秒"'Application.ScreenUpdating = True'打开屏幕刷新
End Sub
'------------获取一段函数运行时间------------

持续更新中......

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.mzph.cn/bicheng/24114.shtml

如若内容造成侵权/违法违规/事实不符,请联系多彩编程网进行投诉反馈email:809451989@qq.com,一经查实,立即删除!

相关文章

遗址博物馆ar互动展示软件提供丰富的趣味化体验

在自然博物馆的每一个角落&#xff0c;都隐藏着大自然的奥秘与魅力。为了让每一位参观者都能深入体验、探索这些奥秘&#xff0c;我们引入了前沿的AR技术&#xff0c;为您带来一场前所未有的沉浸式自然之旅。 步入博物馆&#xff0c;您手中的AR相机将成为您的更佳向导。自然博物…

Python语言在金融领域的应用探索

Python语言在金融领域的应用探索 Python语言&#xff0c;以其简洁、易读和强大的功能库&#xff0c;近年来在金融领域崭露头角。它不仅为数据分析师、量化分析师和交易员提供了强大的工具&#xff0c;还在风险管理、投资组合优化等方面发挥了重要作用。本文将深入剖析Python语…

剪画小程序:图片去除文字,我用它只要10秒!

Hello&#xff0c;大家好呀&#xff01;我是不会画画的小画~ 图片上的文字该如何去除&#xff1f; 在工作或者学习中&#xff0c;我们常常需要处理一些图片文件&#xff0c;比如扫描的文件、 电子文档等。有时候&#xff0c;图片上可能会有文字&#xff0c;这时候需要将图片…

解决富文本中抖音视频无法播放的问题——403

问题 富文本中的抖音视频无法播放&#xff0c;资源状态码是403禁止访问打开控制台&#xff0c;可以看到在项目中打开&#xff0c;数据请求的请求头多了一个Referer: http://localhost:3000/而复制链接在新窗口直接打开&#xff0c;请求头中并不会携带Referer 解决方案 在ind…

在 Windows 7 中安装 .NET Framework 时遇到错误:无法建立到信任根颁发机构的证书链

当全新安装 Windows 7 SP1 后&#xff0c;在未安装任何补丁&#xff0c;也未进行联网的状态下&#xff0c;安装 .NET Framework 4.6/4.7 或更高的版本时&#xff0c; 应该会遇到错误提示&#xff1a;无法建立到信任根颁发机构的证书链。 解决方法 1.下载证书 地址&#xff1…

Selenium三种等待方式的使用!

UI自动化测试&#xff0c;大多都是通过定位页面元素来模拟实际的生产场景操作。但在编写自动化测试脚本中&#xff0c;经常出现元素定位不到的情况&#xff0c;究其原因&#xff0c;无非两种情况&#xff1a;1、有frame&#xff1b;2、没有设置等待。 因为代码运行速度和浏览器…

QT creator c动态链接库的创建与调用

QT creator c动态链接库的创建与调用 QT5.15.2 1.创建dll项目 确保两类型选择正确 2.选择MinGW 64-bit 3.点击完成 pro文件参考&#xff1a; QT - guiTEMPLATE lib DEFINES QT_DLL_DEMO_LIBRARYCONFIG c17# You can make your code fail to compile if it uses deprecat…

[原创][Delphi多线程]使用TMonitor和TQueue配合实现TThreadedQueue的经典使用案例.

[简介] 常用网名: 猪头三 出生日期: 1981.XX.XX QQ: 643439947 个人网站: 80x86汇编小站 https://www.x86asm.org 编程生涯: 2001年~至今[共22年] 职业生涯: 20年 开发语言: C/C、80x86ASM、PHP、Perl、Objective-C、Object Pascal、C#、Python 开发工具: Visual Studio、Delph…

gpt4free软件的 g4f gui 网页速度非常慢的问题解决

问题&#xff1a;g4f gui启动网页很难连上 gpt4free是一个为大众提供的Openai等大模型API调用服务的软件&#xff0c;但是在装好启动g4f gui&#xff0c;使用8080端口连接后&#xff0c;发现网页一直在执行&#xff0c;半天还没好。 怀疑是网页里面的一些js加载有问题。 通过…

MC服务器怎么搭建

MC服务器怎么搭建?随着《我的世界》&#xff08;Minecraft&#xff0c;简称MC&#xff09;的火爆&#xff0c;越来越多的玩家和社区开始搭建自己的MC服务器&#xff0c;与朋友共享创造的乐趣。但搭建一台稳定、高效的MC服务器并不是一件容易的事。今天&#xff0c;我们就来聊聊…

vb.net学习总结

基本语法 Read()函数可充当暂停进行使用 要转换成什么类型就在前面加上C类型&#xff08;&#xff09;即可 取模运算不是%而是Mod 不等于不是!而是<> 在Unicode编码中小写字母比大写字母靠后 Asc&#xff08;char ch&#xff09;取ASC码 使用Is/Like与其他的字符串拼…

【高考】互联网时代,问题何去何从?

随着互联网的普及、人工智能的应用&#xff0c;越来越多的问题能很快得到答案。那么&#xff0c;我们的问题是否会越来越少&#xff1f; 以上材料引发了你怎样的联想和思考&#xff1f;请写一篇文章。 要求&#xff1a;选准角度&#xff0c;确定立意&#xff0c;明确文体&#…

App UI 风格创新无限

App UI 风格创新无限

Java-exam

Java 一卷 T1 /* 编写一个Java程序&#xff0c;求1!2!…10!的值&#xff0c;程序文件命名为“FactoriesSum.java”。*/ package Test.A基础语法.T1;public class FactoriesSum {public static void main(String[] args) {int sum 0,num1;for (int i1;i<10;i){numnum*i;s…

快速制作技术插图,高效管理零部件手册

在当前的制造业和工程领域中&#xff0c;技术插图对于产品设计、制造、维修和市场营销等环节具有至关重要的作用。然而&#xff0c;传统的插图制作方式往往依赖于人工绘制或使用较为复杂的软件&#xff0c;效率低下&#xff0c;而且容易出错。 由于CAD技术的广泛应用&#xff…

备份树莓派系统的多种方法,构建镜像

在我们使用树莓派进行学习或者搭建实验环境时经常会把系统玩坏&#xff0c;辛苦配置的开发环境又得重新配置&#xff1b;或者更新某一软件后发现新版本和某些组件不兼容&#xff0c;又无法降级。这个时候我们会想将系统在稳定时进行备份&#xff0c;在系统出现问题后可以很方便…

网络编程——套接字缓存(buffer)满会丢失数据吗

套接字缓冲区已满并不意味着数据丢失&#xff0c;但它可能会导致发送和接收数据的操作阻塞或失败&#xff0c;从而间接导致数据丢失或延迟。 解释 发送端缓冲区已满&#xff1a; 当发送端的套接字缓冲区已满时&#xff0c;send 或 write 操作会阻塞&#xff0c;直到有足够的空…

爬虫工具yt-dlp

yt-dlp是youtube-dlp的一个fork&#xff0c;youtube-dlp曾经也较为活跃&#xff0c;但后来被众多网站屏蔽&#xff0c;于是大家转而在其基础上开发yt-dlp。yt-dlp的github项目地址为&#xff1a;GitHub - yt-dlp/yt-dlp: A feature-rich command-line audio/video downloaderA …

新手必看!场外期权交易的六大注意事项

场外期权交易的六大注意事项 对于初涉金融市场的投资者来说&#xff0c;场外期权交易无疑是一个既具吸引力又充满挑战的领域。为确保您在交易中能够稳健获利&#xff0c;以下六大注意事项值得每位新手仔细研读。 文章来源/&#xff1a;财智财经 一、深入理解期权基本概念 场…

《动态网站建设》

动态网站建设 试题类型 试题数量 总分 论述题 1 10.00分 名词解释 2 20.00分 简答题 3 30.00分 论述题 ASP.NET有什么优点?性能强大:ASP.NET允许早期绑定、实时编译、本机优化和盒外缓存服务,这意味着在编写代码行之前便显著提高了性能。 安全性高:ASP.NET为Web应用程序提供…