不知道为什么计组老师的大量课件字体是伤害视力的亮蓝色……看久了眼睛疼,想把颜色替换成保护视力一点的灰色,但是找了N久也没找到在图形界面上直接操作的方法,于是在MSDN上晃了晃,Google了一下,写了个VBA小脚本,只替换选定颜色,这样可以保留红色或者其他颜色的高亮,顺便把让人分心的花花背景也干掉. Sub ReplaceColor() Dim shape As shape Dim slide As slide Dim txt As TextRange On Error Resume Next
Public Sub ModifyFileNames() Dim FolderPath As String Dim FileNames As Variant Dim dotPos As Long Dim ExtName As String Dim RealName As String Dim NewFile() As String ReDim NewFile(1 To 1) As String Dim Index As Long Dim StartTime As Variant Dim Used
今天,有同事提出想批量修改文件名,规则比较简单,在第五位后加“-”即可, 上网没找到相关工具,就自己做了个excel,用宏代码修改. 代码如下: Private Sub CommandButton1_Click() Dim varFileList As Variant MsgBox "选择要重命名文件所在的文件夹,点击确定!" With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = F
虽然平常在用excel 2010重命名工作表的时候,一般可能会用"双击工作表"的方法来重名,但是遇到大批量重名的时候就很麻烦. 我的方法,先建一张新表,然后在第一列写好要命名的表名字,然后在VBE窗口里面输入代码 Sub rename() '批量工作表重命名 Dim i As Integer For i = 1 To 5 Worksheets(i).Name = Cells(i, 1) Next End Sub
// 下述代码将创建一个KDTable,并指定列名.表头单元格的显示值.和表体数据KDTable table = new KDTable();String [] columnKeys = new String[]{"a","b","c","d"};String [] head = new String[]{"a1","b1","c1","d1"};
sub 批量新建指定名称的工作表() Dim i As Integer For i = 2 To 10 '根据实际情况修改i大小 Worksheets.Add after:=Worksheets(ThisWorkbook.Worksheets.Count) ActiveSheet.Name = Sheets(1).Cells(1, i) Next End Sub
需求:因为处理学生学籍照片,从照相馆拿回来的寸照是按班级整理好,文件名是相机编号的文件.那么处理的话,是这么一个思路,通过Excel表格打印出各班A4照片列表,让学生自行填上照片对应姓名.表格收回来后Excel表格上填入对应姓名,通过VBA更改电子档照片文件名. Function getSubDirectory()'获取当前文件的下层所有目录 Dim strCurDir, strDirectoryName, strDirs As String Dim arrDirectoryName() Dim
Function findAndCopy(srcFile As String, destFile As String, cmdFile As String) Dim WSH As Object, wExec As Object, result Dim val, n Dim i As Integer Dim sFile As Object, Fso As Object Dim cmdStr As String Set WSH = CreateObject("WScript.Shell")
Sub EditCsvToXls() Application.ScreenUpdating = False '文件目录 ChDir "C:\Users\QA-Department\Desktop\test" Dim sDir As String Dim curdir As String curdir = "C:\Users\QA-Department\Desktop\test" sDir = Dir(curdir & "\*.csv")
感谢会飞的鱼大牛~ Public fp$, obmapp As Object Sub kk() 文件夹浏览器 Application.ScreenUpdating = False Set fso = CreateObject("scripting.filesystemobject") If fp = "" Then Exit Sub Set ff = fso.getfolder(fp) Documents.Add DocumentType:=wdNewBlankDo
alt+F11打开宏编辑窗口,输入以下代码,运行即可: Sub removeALL() Dim I As Integer: Dim J As Integer Dim oActivePres As Object Set oActivePres = ActivePresentation With oActivePres For I = 1 To .Slides.Count If Val(Application.Version) <10 Then For J = 1 To .Slides(I).Sha
Sub hong3()'' 宏3 宏d Dim a, b As Integer Dim str As String For a = 227 To 947 Step 15 b = a + 5 str = "Sheet1!B" + CStr(a) + ":G" + CStr(b) sh = ActiveSheet.Shapes.AddChart2(216, xlBarClustered) sh.Select ActiveChart.SetSourceData Sourc
