批量清除文件夹下excel文件的公式，但保留数值的VBN宏代码

小菜鸟哦哦

lsc900707 发表于 2017-12-28 11:46
你后面几个表中的焊工证号要设置成文本格式，你设置成了自定义日期格式！

可以在您的代码中加上忽略错误继续运行的代码吗？

lsc900707

小菜鸟哦哦 发表于 2017-12-28 18:41
可以在您的代码中加上忽略错误继续运行的代码吗？

你几秒钟就可以搞定的事还要去修改代码？

小菜鸟哦哦

lsc900707 发表于 2017-12-28 19:09
你几秒钟就可以搞定的事还要去修改代码？

不是的大神，我这样的文件有很多个，而且在不同的文件夹里，文件夹还会互相嵌套。所以工作量还是比较大的。您看看能不能帮忙修改一下。真的是工作量太大了，所以又不得不要麻烦您了

小菜鸟哦哦

lsc900707 发表于 2017-12-28 19:09
你几秒钟就可以搞定的事还要去修改代码？

大神您好！可以再麻烦您一下吗？
向您请教如何在您这个代码中加上：如果某个工作簿中有工作表已被保护，就把该工作簿删除的代码。其他部分不变。我在您的代码中修改了下，可是运行之后显示错误，劳烦您帮我看一下吧。感激不尽

yusanli

lsc900707 发表于 2016-12-3 21:15
Dim arrf(), mf&
Sub lsc()
    Dim Fso As Object, i&, sFileType$, na As Name

求教老师，您这个代码可以清除公式，但是会把身份证号码变成3.62202E+17之类的科学计数法，最后3位数字变成了0.请求老师再修改一下代码，不会变更身份证号码。

lsc900707

yusanli 发表于 2018-1-26 12:29
求教老师，您这个代码可以清除公式，但是会把身份证号码变成3.62202E+17之类的科学计数法，最后3位数字变 ...

没有附件，自己设置单元格格式吧。

yusanli

lsc900707 发表于 2018-1-29 10:16
没有附件，自己设置单元格格式吧。

已上传了附件，请求大神帮忙看一下

right1406

这个可以留着用一下

cjc209

Dim arr(), s&
Sub ttt()
  mypath = ThisWorkbook.Path
  s = 0
  Zdir ThisWorkbook.Path
Application.ScreenUpdating = False
For Each hhl In arr
    If hhl <> "" Then
    MyName = Dir(hhl)
    AWbName = ThisWorkbook.Name
        If MyName <> AWbName And MyName <> "" Then
            Set wb = Workbooks.Open(hhl)
            For Each sh In wb.Worksheets
               sh.UsedRange.Value = sh.UsedRange.Value
            Next sh
          Application.DisplayAlerts = False
           wb.Close True
        Application.DisplayAlerts = True
        End If
      End If
Next
Application.ScreenUpdating = True
End Sub
Sub Zdir(P)
Set Fso = CreateObject("scripting.filesystemobject")
For Each f In Fso.GetFolder(P).Files
If f Like "*.xls*" Then
    s = s + 1
ReDim Preserve arr(1 To s)
    arr(s) = f
    End If
Next
For Each m In Fso.GetFolder(P).SubFolders
    Zdir m
Next
End Sub

cjc209

因为有长于15位的数字 只能文本格式化
Dim arr(), s&
Sub ttt()
  mypath = ThisWorkbook.Path
  s = 0
  Zdir ThisWorkbook.Path
Application.ScreenUpdating = False
For Each hhl In arr
    If hhl <> "" Then
    MyName = Dir(hhl)
    AWbName = ThisWorkbook.Name
        If MyName <> AWbName And MyName <> "" Then
            Set wb = Workbooks.Open(hhl)
            For Each sh In wb.Worksheets
               sh.UsedRange.NumberFormatLocal = "@"
               sh.UsedRange.Value = sh.UsedRange.Value
            Next sh
          Application.DisplayAlerts = False
           wb.Close True
        Application.DisplayAlerts = True
        End If
      End If
Next
Application.ScreenUpdating = True
End Sub
Sub Zdir(P)
Set Fso = CreateObject("scripting.filesystemobject")
For Each f In Fso.GetFolder(P).Files
If f Like "*.xls*" Then
    s = s + 1
ReDim Preserve arr(1 To s)
    arr(s) = f
    End If
Next
For Each m In Fso.GetFolder(P).SubFolders
    Zdir m
Next
End Sub