精华内容
下载资源
问答
  • Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) d = Format(Now(), "yyyy-mm-dd_HH.mm.ss") s = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) ThisWo...

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    d = Format(Now(), "yyyy-mm-dd_HH.mm.ss")
    s = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    ThisWorkbook.SaveCopyAs "E:\test\" & s & "_" & d & ".xlsm"

    End Sub

    转载于:https://www.cnblogs.com/doctorsun/p/7684363.html

    展开全文
  • Sub changeFile() '出错时直接跳到完成 On Error GoTo 100 Dim file As String Dim basePath As String ... basePath = InputBox("请输入路径") If basePath = "" Then MsgBox "请输入路径" Exit Sub En
    Sub changeFile()
     '出错时直接跳到完成
      On Error GoTo 100
      Dim file As String
      Dim basePath As String
      Dim val
      basePath = InputBox("请输入路径")
      If basePath = "" Then
          MsgBox "请输入路径"
          Exit Sub
      End If
      val = InputBox("请输入你要修改成的值")
      '忽略修改警告
       Application.DisplayAlerts = False
      '查找某路径下面所有的txt文档并弹出文件名
      file = Dir("C:\Users\星驰太帅了\Desktop\excel\*.xlsx")
      a = SetValue(basePath, file, val)
      Debug.Print "根文件下面的文件   " & file
        '如果文件名不为空代表还有文件,那么就一直循环
        Do While file <> ""
         '第二次不需要再填写路径,要不然会造成死循环
         file = Dir
         '再判断一下,免得当为空时还做了操作
         If file = "" Then Exit Do
         a = SetValue(basePath, file, val)
         Debug.Print "根文件下面的文件   " & file
        Loop
      '结束语提示
         Debug.Print "end"
      '重新开启警告
       Application.DisplayAlerts = True
    100:
        MsgBox "修改完成"
    
    End Sub
    
    Function SetValue(basePath, worksPath, value)
      Dim rowCount
      Dim c As Range
      filePath = basePath & worksPath
      With Workbooks.Open(filePath)
            '第一列最后一行
           rowCount = .Sheets(1).Cells(Rows.Count, 1).End(xlUp).row
           For Each c In Range("a1:a" & rowCount)
                If c.value = "编制日期:" Then
                .Sheets(1).Cells(c.row, 2).value = value
                Exit For
                End If
           Next
           .Save '修改完需要保存文件
           .Close
      End With
    
    End Function



    可以用find 函数更容易,如下


    Function SetValue(basePath, worksPath, value)
      Dim c As Range
      Dim rowCount As Range
      filePath = basePath & worksPath
      With Workbooks.Open(filePath)
            '第一列最后一行
           Set rowCount = .Sheets(1).Cells.Find("编制日期:", , xlFormulas, , , xlPrevious)
           .Sheets(1).Cells(rowCount.row, 2).value = value
           .Save '修改完需要保存文件
           .Close
      End With
    
    End Function
    


    展开全文
  • VBA 弹框选择文件路径

    千次阅读 2017-10-30 20:17:34
    弹框选择文件路径
    Sub chooseDocumentPath()
    'Auther 云浮清秋
    '弹框选择文件路径
    '----------------------------------------------
        Dim dataExcel, Workbook, dataSheet, filePath
        Dim totalRow  As Integer
      
        Set dataExcel = CreateObject("Excel.Application")
    
        filePath = Application.GetOpenFilename(Title:="弹框显示的标题文本内容", MultiSelect:=False) '可以选择各种格式的文件
    
        '  filePath = Application.GetOpenFilename("Excel Files (*.xls*), *.Excel")     '必须选择excel格式的文件
    
    
    
        If   filePath <> False Then 
            Set Workbook = dataExcel.Workbooks.Open(filePath)
    
            Set dataSheet = Workbook.Worksheets(1)
    
    On Error GoTo noData
    
            totalRow = dataSheet.UsedRange.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
            For i = 2 To totalRow
                  Sheets("sheet1").Cells(i, 1) = dataSheet.Cells(i, 1)
                  Sheets("sheet1").Ce
    展开全文
  • 使用说明 本人为初学者,根据大神的写法弄的精简版,中间出现空格可正常统计。 未进行序号填充 ... 其他BUG后续后继续完善 ...Sub 表格关键词拆分() Application.ScreenUpdating = False Dim x As Integer, y As ...

    使用说明

    本人为初学者(写的不好轻喷),根据大神的写法弄的精简版,中间出现空格可正常统计。

    未进行序号填充

    点击取消会报错

    其他BUG后续将会继续完善

    Sub 表格关键词拆分()
    Application.ScreenUpdating = False
    Dim x As Integer, y As Integer, w As Worksheet
    inputcol = InputBox("请输入拆分列所在序号")
    x = 2
    y = inputcol
    Set w = Worksheets(1)
    Do While w.Cells(x, y).Value <> ""
        On Error Resume Next
        If Worksheets(w.Cells(x, y).Value) Is Nothing Then
            Worksheets.Add after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = w.Cells(x, y).Value
            w.Cells(1, 1).Resize(1, 100).Copy Worksheets(w.Cells(x, y).Value).Cells(1, 1)
        End If
        w.Cells(x, 1).Resize(1, 100).Copy Worksheets(w.Cells(x, y).Value).Range("A60000").End(xlUp).Offset(1, 0)
    x = x + 1
    Loop
    
    Dim folder As String
    folder = ThisWorkbook.Path & "拆分工作表"
    If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder
    Dim i As Integer, sht As Worksheet
    For i = 2 To Sheets.Count
        Sheets(i).Copy
        ActiveWorkbook.SaveAs folder & "\" & Sheets(1).Name & ".xls"
        ActiveWorkbook.Close
    Next
    End Sub
    

    展开全文
  • 利用VBA将表格保存为PDF文件

    千次阅读 2020-07-01 23:04:15
    下面的函数即可以实现将指定表的内容保存为PDF文件。 保存文件前,需要确认表格内容已经是排版完成的内容,此函数没有排版的功能,具体请大家自行测试。 函数代码 Function SaveAsPDF(Optional FlName As String = ...
  • Sub 获取Excle模板保存路径() MsgBox "获取Excle模板保存路径:" & Application.TemplatesPath End Sub 点击“运行程序”,效果图如下: 附件下载 转载于:...
  • 使用vb按指定路径及文件名将EXCEL另存为横版PDF等格式
  • vba上传指定文件ftp服务器

    千次阅读 2019-07-23 14:04:19
    -【宏】2.2 【宏】-【编辑】2.3 【把脚本复制进去】2.4 脚本如下2.5 修改位置2.5.1 修改sheet名称和表格一致2.5.2 修改Cells(2,3)2.5.3 修改4 to 1002.5.4 修改Cells(i,3)2.5.5 修改发ftp信息2.5.6 保存脚本三、添加...
  • 技术质量管理杂谈导读 Microsoft Excel几乎无处不在,使用Excel既可以保存数据,还可以跟踪数据活动趋势。人们使用Excel的方式五花八门,难以计数。Excel已经成为商业活动中不可或缺的工具。Excel本身不仅可以实现...
  • '''''''指定日期格式 '''''''  idate = Format(Date, "yy.MM.dd")  cname = 合同名称  obname = 项目名称  name =制作人  what =名牌 '''''''创建文件夹 '''''''   Set oFso = CreateObject("Scripting....
  • 获取当前文件夹的名称(CurDir 函数)当你使用文件时,经常会需要知道当前文件夹的名称,你使用CurDir函数轻易地获取该信息:CurDir([drive])Drive是一可选参数,如果你忽略它,VBA将使用当前驱动(drive)。CurDir函数...
  • 保存outlook指定文件夹下附件(VBA

    千次阅读 2009-09-02 14:30:00
    在outlook里Visual Basic 编辑器里,添加一下窗口,如图: 代码如下:Private Sub btnSaveAttachment_Click()Dim strnameDim wcountwcount = 0Dim savefolder====对给定文件夹进行标准化=================If (Right...
  • VBA 是一种很久远的编程语言,但并不过时。在满足以下两个条件时,借助 VBA 可以极大的提升生产率,降低出错率:你的电脑上不允许自主安装软件; 你需要执行的工作中大部分的步骤都是固定且重复的。项目背景近期接到...
  • 这个小程序的前提是指定的文件夹里装的全部是图片格式的文件 步骤1: 添加一个filesystemobject引用,工具--->引用---->microsoft scripting runtime 步骤2: 添加模块,并添加以下代码 Option ...
  • VBA删除某些文件夹下的所有文件

    千次阅读 2020-11-29 16:04:58
    '这个vba代码是后处理的代码,加载阶段未接触上进行修正 Dim i, jj, kk As Integer Dim wb As Workbook For i = 1 To 10 str = Dir("C:\Users\DELL\Desktop\保存\*.*") 'str就是带有.xlsx的文件名 If str = "" T...
  • VBA++ 题记:一剪闲云一溪月,一程山水一年华。一世浮生一刹那,一树菩提一烟霞。岁月静好,现世安稳。纵算云水漂泊,心若安宁,亦可淡若清风。希望见者与不见者都能安康。静下心,多学习有用的知识,多提高自己的...
  • 效果图: [img]... 对应的代码入下: [code="vba"] 对应的代码入下: Sub getColumn() Dim work1 As Workbook Di...
  • Excel VBA获取选择文件的文件名称

    千次阅读 2020-10-20 10:50:20
    '打开文件对话框返回的文件名,是一个全路径文件名,其值也可能是False,因此类型为Variant Dim i As Integer File = Application.GetOpenFilename("Excel 文件,*.xls;*.xlsx;*.xlsm") '调用Windows打开文件...
  • 这部分内容涉及的知识点有:多工作薄交叉复制、获取某一目录下所有excel工作薄、获取某一目录下所有指定类型excel工作薄、创建工作薄、打开工作薄并操作   现在把代码整理贴出来,方便以后参考调用。   ...
  • 如图所示,如何利用VBA将该工作簿中的各个工作表分别保存至单独的工作簿中,并将工作簿名称以工作表标签命名? 部门 市场部 员工编号 姓名 0215 林革壮 0233 李卫卿 0247 申玲 ...
  •  '# 生成create 语句写入sql文件,存放到指定目录下  Sheets("Sheet2").Activate      For num = 6 To M  Dim columm_type_m As String  columm_type_m = Sheet2.Range("C" & num).Value      ...
  • 本文介绍在 CorelDRAW VBA中使用官方原生工具 CorelScriptTools 调用文件对话框,选择文件并获得文件路径VBA代码。其提供的 GetFileBox 方法可用来打开文件对话框(或者另存为对话框)。 CorelScriptTools ...
  • ' 代码段进行调用,用户选择的目录将保存在strPath字符串变量下; ' (3) 如果用户选择"取消"按钮,则strPath的值为空; ' ******************************************************************* Public Function ...
  • 所以针对这个问题,用VBA写了个分列和保存的宏。 一、使用前说明: 1.要分列的表列中间不要出现空内容,比如要分第2列部门,里面有A部门,B部门,还有个空内容的,可能导致计算行数不准。 2.分列后的表序号...
  • '依次打开当前文件夹中所有的工作簿并且向该工作簿中的工作表中写入内容后并保存 Sub OpenAndSave() Dim myPath$, myFile$, AK As Workbook Dim sh As Worksheet Dim i As Integer i = 2 Dim fname As ...
  • 例如Windows和DOS操作系统中的path环境变量,当要求系统运行一个程序而没有告诉它程序所在的完整路径时,系统除了在当前目录下面寻找此程序外,还应到path中指定路径去找。用户通过设置环境变量,来更好的运行进程...
  • 1、本工具适用将指定路径下的所有Excel文件合并为一个Excel文件(包含.xls,.xlsx拓展名)并保存指定路径。 2.导入此jar.然后调用相应的方法,传入指定的参数即可。
  • VBA 文件对话框

    千次阅读 2019-08-13 20:31:11
    如果指定了无效路径,则将使用上次使用的路径。 如果使用无效路径,则系统会向用户发出警告消息。 将此属性设置为长度超过 256 个字符的字符串会导致运行时错误。 InitialView 属性,读/写,获取或设置一...
  • 一、提取单层文件内的文件名 ... '获取用户选择文件夹的路径 With Application.FileDialog(msoFileDialogFolderPicker) '选择文件夹 If .Show Then p = .SelectedItems(1) '选择的文件路径赋值变量P Else
  • 网页爬虫实践——VBA调用JS事件

    千次阅读 2018-04-15 15:53:05
    网页爬虫实践——VBA调用JS事件作者:AntoniotheFuture关键词:VBA,网页爬虫,网抓,JavaScript,Access开发平台:Access平台版本上限:2010平台版本下限:尚未出现开发语言:VBA简介:公司要求我们在双12那天之前...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 2,071
精华内容 828
关键字:

vba指定保存路径