VBA教程
Excel中vba教程 设置行高实例
在excel工作表中对单元格进行行高设置操作，一般情况下，都是通过点击菜单：格式——行——行高，然后进行设置。 为了让大家逐渐熟悉Excel中vba基础知识，我们通过一系列的实例来加以介绍。 首先运行excel，新建一工作表，输入如下数据，详见下图： 输入完数据后，进行按钮的录入和VBA代码编写部分。 第一，依次单击菜单：视图——工具栏——窗体，调出窗体工具栏。 第二，单击窗体工具栏中的按钮，鼠标成为十字形状，然后在工作界面拖动一矩形框，松开鼠标，完成按钮的录入。 第三，松开鼠标后，会弹出“指定宏”对话框，单击其中的“新建”，出现Visual Basic代码编写界面。 第四，全选代码界面现有的代码，删除，并将下面一段代码复制进去： Sub 设置行高() Dim h As Long, r As Long, i As Integer, n As Integer Dim ws1 As Worksheet h = Application.InputBox(prompt:="请输入所选行的高度：", _ Title:="输入行高", Type:=1) Set ws1 = ActiveSheet n = Selection.Rows.Count r = ActiveCell.Row For i = 1 To n ws1.Rows(r + i - 1).RowHeight = h Next Set ws1 = Nothing End Sub 第五，单击保存，关闭Visual Basic代码编写界面，并右击该按钮，选中按钮上的文字，重命名为：设置行高。 第六，参考1-5步的操作，在页面新建另外一个按钮，并重命名为：自动设置行高。该按钮的代码为： Sub 自动调整行高() Selection.Rows.AutoFit End Sub 第七，完成上面的操作，最后的界面就如上图所示的一样了。然后，当我们点击工作表中的“设置行高”按钮，就会弹出“输入行高”对话框，可以在这里输入数值来调整行高。也可以单击“自动设置行高”按钮，来清除所设定的行高。
如何在Excel 2013/2016/2019中获取工作簿中每个工作表的数据大小
本文将讲述如何在Excel中获取到当前打开工作簿的每个工作表的数据大小。如何在Excel 2013/2016中获取工作簿中每个工作表的数据大小。假设您有一个包含多个工作表的工作簿，并且您想知道当前工作簿中每个工作表的数据大小。本文将向你演示两种获取工作数据数据大小的方法。您可以手动逐个获取每个工作表的数据大小，只需要在工作簿中复制Excel工作表的内容，然后创建一个新工作簿，并将内容粘贴到新工作簿中的sheet1中，然后将新工作簿保存到Windows文件夹。然后你可以得到这个新工作簿的大小。您可以重复上述步骤，在工作簿中逐个获取其他工作表的数据大小。如果要快速获取当前工作簿中每个工作表的数据大小，可以使用Excel VBA宏来完成它。只需执行以下步骤：步骤1：打开您的Excel工作簿，然后单击开发工具选项卡下的“Visual Basic”命令，或者只需按“ALT + F11”快捷方式。步骤2：然后将出现“Visual Basic编辑器”窗口。步骤3：单击“插入” – >“模块”以创建新模块。
excel N页数据汇总，你还在手动复制粘贴？
实际工作当中我们会碰到按日、按月、按年分类统计，当数据需要汇总一起时，你还在一页一页的老（泪）老（流）实（满）实（面）的复制粘贴吗？？？~~T_T|||……,如果真是这样，真是心里面一万个*在狂奔吧。下面小编告诉你一个简单又实际的方法，VBA一键汇总~~~点击开发工具——Visual Basic，输入以下经文，Sub combine()Application.ScreenUpdating =FalseFor j = 1 ToSheets.CountIf Sheets(j).Name <>ActiveSheet.Name ThenX =Range("A65536").End(xlUp).Row + 1Sheets(j).UsedRange.Copy Cells(X, 1)
如何在Excel中批量重命名多个文件
本文将将讲述如何使用Excel中的VBA宏重命名给定目录中的多个文件。如何在Excel中批量重命名多个文件。假设你有多个Excel工作簿文件，如：test1.xlsx，test2.xlsx ……等。您希望批量将所选目录中所有文件重命名为另一种格式，我们该如何快速实现它呢？最好的方法是使用Excel VBA宏重命名所有文件名。只需执行以下步骤：步骤1：您需要在当前工作表中键入所有文件名，然后创建一个包含新文件名列表的新列。步骤2：打开您的Excel工作簿，然后单击开发工具选项卡下的“Visual Basic”命令，或者只需按“ALT + F11”快捷方式。步骤3：然后将出现“Visual Basic编辑器”窗口。
Excel 如何按指定的单元格颜色进行计数或求和
如果Excel工作表的某区域中包含不同的底纹颜色，我们可以用一个自定义函数对该区域按指定的单元格颜色进行计数或求和。方法是：1.按Alt+F11，打开VBA编辑器。2.单击菜单“插入→模块”，将插入名称为“模块1”的模块，在右侧的代码窗口中输入下列代码： Function SumByColor(Ref_color As Range, Sum_range As Range) Application.Volatile Dim iCol As Integer Dim rCell As Range iCol = Ref_color.Interior.ColorIndex For Each rCell In Sum_range If iCol = rCell.Interior.ColorIndex Then SumByColor = SumByColor + rCell.Value End If Next rCell End Function Function CountByColor(Ref_color As Range, CountRange As Range) Application.Volatile Dim iCol As Integer Dim rCell As Range iCol = Ref_color.Interior.ColorIndex For Each rCell In CountRange If iCol = rCell.Interior.ColorIndex Then CountByColor = CountByColor + 1 End If Next rCell End Function上述两个自定义函数，一个是SumByColor，可以对区域按指定单元格的颜色求和。另一个是CountByColor，可以统计区域中某种颜色的个数。这两个自定义函数都有两个参数，前一个参数指定包含某种颜色的单元格，后一个参数为求和或计数区域。3.关闭VBA编辑器。使用方法：假如要求和或计数的区域在A1:B10区域中。求出该区域中单元格底纹颜色为红色的所有单元格数值之和，在单元格中输入公式：=sumByColor(A1,A1:B10)求出该区域中单元格底纹颜色为红色的所有单元格的个数，在单元格中输入公式：
excel VB 利用GDI+保存图片为JPG、TIFF、PNG、GIF、BMP等格式
Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Private Type EncoderParameter GUID As GUID NumberOfValues As Long type As Long Value As Long End Type Private Type EncoderParameters count As Long Parameter As EncoderParameter End Type Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long Private Declare Function CLSIDFromString Lib "ole32" (ByVal Str As Long, id As GUID) As Long Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long '************************************************************************* '** 作 者 ： laviewpbt '** 函 数 名 ： SavePic '** 输 入 ： pic(StdPicture) - 图 象句柄 '** ： FileName(String) - 保 存路径 '** ： Quality(Byte) - JPG 图象质量 '** ： TIFF_ColorDepth(Long) - TTF 格式的颜色深度 '** ： TIFF_Compression(Long) - TTF 格式的压缩比 '** 输 出 ： 无 '** 功能描述 ： 把图象保存为JPG、 TIFF、PNG、GIF、BMP格式 '************************************************************************* Private Sub SavePic(ByVal pict As StdPicture, _ ByVal FileName As String, _ PicType As String, _ Optional ByVal Quality As Byte = 80, _ Optional ByVal TIFF_ColorDepth As Long = 24, _ Optional ByVal TIFF_Compression As Long = 6) Screen.MousePointer = vbHourglass Dim tSI As GdiplusStartupInput Dim lRes As Long Dim lGDIP As Long Dim lBitmap As Long Dim aEncParams() As Byte On Error GoTo ErrHandle: tSI.GdiplusVersion = 1 ' 初始化 GDI+ lRes = GdiplusStartup(lGDIP, tSI) If lRes = 0 Then ' 从句柄创建 GDI+ 图像 lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap) If lRes = 0 Then Dim tJpgEncoder As GUID Dim tParams As EncoderParameters '初始化解码器的GUID标识 Select Case PicType Case ".jpg" CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder tParams.count = 1 ' 设置解码器参数 With tParams.Parameter ' Quality CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID ' 得到Quality参数的GUID标识 .NumberOfValues = 1 .type = 4 .Value = VarPtr(Quality) End With ReDim aEncParams(1 To Len(tParams)) Call CopyMemory(aEncParams(1), tParams, Len(tParams)) Case ".png" CLSIDFromString StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder ReDim aEncParams(1 To Len(tParams)) Case ".gif" CLSIDFromString StrPtr("{557CF402-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder ReDim aEncParams(1 To Len(tParams)) Case ".tiff" CLSIDFromString StrPtr("{557CF405-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder tParams.count = 2 ReDim aEncParams(1 To Len(tParams) + Len(tParams.Parameter)) With tParams.Parameter .NumberOfValues = 1 .type = 4 CLSIDFromString StrPtr("{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"), .GUID ' 得到ColorDepth参数的GUID标识 .Value = VarPtr(TIFF_Compression) End With Call CopyMemory(aEncParams(1), tParams, Len(tParams)) With tParams.Parameter .NumberOfValues = 1 .type = 4 CLSIDFromString StrPtr("{66087055-AD66-4C7C-9A18-38A2310B8337}"), .GUID ' 得到Compression参数的GUID标识 .Value = VarPtr(TIFF_ColorDepth) End With Call CopyMemory(aEncParams(Len(tParams) + 1), tParams.Parameter, Len(tParams.Parameter)) Case ".bmp" '可以提前写保存为BMP的代码，因为并没有用GDI+ SavePicture pict, FileName Screen.MousePointer = vbDefault Exit Sub End Select lRes = GdipSaveImageToFile(lBitmap, StrPtr(FileName), tJpgEncoder, aEncParams(1)) '保存图像 GdipDisposeImage lBitmap ' 销毁GDI+图像 End If GdiplusShutdown lGDIP '销毁 GDI+ End If Screen.MousePointer = vbDefault Erase aEncParams Exit Sub ErrHandle: Screen.MousePointer = vbDefault MsgBox "在保存图片的过程中发生错误:" & vbCrLf & vbCrLf & "错误号: " & Err.Number & vbCrLf & "错误描述: " & Err.Description, vbInformation Or vbOKOnly, "错误" End Sub
Excel VBA 窗体之添加最大最小化按钮 实现代码
VBA的窗体和一般的程序窗体不太一样，一般的窗体都会有一个最大化和一个最小化按钮，而VBA窗体却只有一个关闭按钮。这样就使VBA的窗体在使用的时候会有一些不太方便，下面我们就来为它添加最大和最小化按钮。附件下载：点击链接从百度网盘下载操作如下：◾在Excel的VBE窗口中插入一个用户窗体，将其命名为frmMaxMin。然后再添加一个模块。在窗体和模块中添加后面所列代码。◾在工作薄中的任意工作表中添加一窗体按钮控件，将指定其设置宏为btnShowfrmMaxMin_Click。其供示范之用。具体代码："ModToolsForm"模块代码Sub btnShowfrmMaxMin_Click() frmMaxMin.Show End Sub"frmTools" 窗体代码
Excel VBA 窗体之添加窗体图标 实现代码
VBA的窗体其实就是一个Dialog(对话框窗体)，缺少完整窗体的许多元素，窗体标题栏上的图标就是其中之一，有时我们自己需要美化一下它，使用代码来为它添加窗体图标(如图)。附件下载：点击链接从百度网盘下载操作如下：◾在Excel的VBE窗口中插入一个用户窗体，将其命名为frmIcon。然后再添加一个模块。在窗体和模块中添加后面所列代码。◾在工作薄中的任意工作表中添加一窗体按钮控件，将指定其设置宏为btnShowfrmIcon_Click。其供示范之用。具体代码："mdIcon"模块代码 Sub btnShowfrmIcon_Click() frmIcon.Show End Sub
Excel VBA 窗体之特殊形状窗体 几何形状组合窗体 实现代码
在VBA中我们有时需要一些特殊形状的窗体来美化我们的程序，比如说几个几何形状的组合样式的窗体。那我们就来作一个同心圆形状的窗体： 本示例主要运用 API 函数来定制化Excel中的用户窗体，使其显示特殊形状 附件下载：点击链接从百度网盘下载操作如下：◾在Excel的VBE窗口中插入一个用户窗体，将其命名为EspecialForm。然后再添加一个模块。然后在窗体和模块中添加后面所列代码。◾在工作薄中的任意工作表中添加一窗体按钮控件，将指定其设置宏为ShowForm。其供示范之用具体代码："mdEspecial"模块代码Sub btnShowEspecial_Click() frmEspecial.Show End Sub"frmEspecial" 窗体代码
如何使用Excel VBA宏创建一个包含工作簿中所有工作表名称的动态列表
本文将讲述如何在Excel中动态获取当前工作簿中所有工作表名称。如何使用Excel VBA宏创建一个包含工作簿中所有工作表名称的动态列表。假设您有一个包含大量工作表的Excel工作簿，并且您希望获得当前工作簿中所有工作表名称的动态列表。这篇文章将会讲述两种创建动态工作表名称列表的方法。步骤1：转到Excel功能区中的“公式”选项卡，然后单击“定义的名称”组下的“定义名称”命令。并且将打开“新建名称”对话框。步骤2：在“新建名称”对话框的“名称”字段中输入“SheetList”。然后输入以下公式：=REPLACE(GET.WORKBOOK(1),1,FIND(“]”,GET.WORKBOOK(1)),””)步骤3：单击“确定”按钮，然后在单元格A1中输入数字1，在单元格A2中输入数字2。步骤4：在A列中选择这两个单元格并将它们向下拖动到的输入序列号3,4,5等。