这个遍历文件夹代码是我搜的。放在我这个代码里用不起来

wdh540119878 · 发表于 2022-11-22 02:30

本帖最后由 wdh540119878 于 2022-11-22 10:38 编辑

这个遍历文件夹代码是我搜的。放在我这个代码里用不起来

Sub 打开文件夹内所有Excel表格并修改() '打开文件夹内所有Excel表格并修改
'
'
'
Dim myPath$, myFile$, WB As Workbook '这个$是相当于定义字符串

myPath = "F:\批量修改\修改\" '把文件路径定义给变量，这里请自行更改，记得最后要加一个反斜杠

myFile = Dir(myPath & "*.xls*")  '依次找寻指定路径中的*.x1s,或者x1sx文件

Do While myFile <> "" '当指定路径中有文件时进行循环

      If myFile <> ThisWorkbook.Name Then '如果我们这个宏文件在需要处理的文件夹之中，这个判断就会跳过下面的操作

      Set WB = Workbooks.Open(myPath & myFile) '打开符合要求的文件


  Rows("2:2").Select '第二行上方插入2行
With Rows("2:3")
      .Insert Shift:=xlShiftDown
      .Select

ActiveSheet.Columns("F").Insert  '插入列
ActiveSheet.Columns("C").Insert

Range("A2:B2 ").MergeCells = True                                        '合并A2-B2
Range("A3:B3 ").MergeCells = True                                        '合并A3-B3
Range("D2:G2 ").MergeCells = True                                        '合并D2-G2
Range("D3:G3 ").MergeCells = True                                        '合并D3-G3
Range("H2:I2 ").MergeCells = True                                        '合并D2-G2
Range("H3:I3 ").MergeCells = True                                        '合并D3-G3

Range("A2:B2").Select
ActiveCell.FormulaR1C1 = "类别"                                  'A2单元格内容

Range("C2").Select                                        'C2单元格内容
ActiveCell.FormulaR1C1 = "卷号"

Range("D2:G2").Select
ActiveCell.FormulaR1C1 = "案卷题名"                                  'A2单元格内容

Range("H2:I2").Select
ActiveCell.FormulaR1C1 = "保管期限"                                  'A2单元格内容

Range("A4").Select
ActiveCell.FormulaR1C1 = "序号"

Range("B4:C4").Select
ActiveCell.FormulaR1C1 = "责任者"

Range("D4").Select
ActiveCell.FormulaR1C1 = "文件号"

Range("E4").Select
ActiveCell.FormulaR1C1 = "文件题名"

Range("F4").Select
ActiveCell.FormulaR1C1 = "文件日期"

Range("G4").Select
ActiveCell.FormulaR1C1 = "何种文字"

Range("H4").Select
ActiveCell.FormulaR1C1 = "所在页码"

Range("I4").Select
ActiveCell.FormulaR1C1 = "备注"

Rows("1:65535").Select          '所有单元格改文本格式
Selection.NumberFormatLocal = "@"

Range([A2], [I4]).Borders.Weight = 2 'A2-I4加边框，1为虚线，0为无边框

Rows("1:1").Select             '1行字体字号
With Selection.Font
      .Name = "宋体"
      .Size = 20
   End With

Rows("2:4").Select             '3行字体字号
With Selection.Font
      .Name = "宋体"
      .Size = 11
End With

myendrow = Cells(6500, 1).End(xlUp).Row '4-1200行字体字号
Rows("5:" & 1200).Select
With Selection.Font
      .Name = "宋体"
      .Size = 10
End With

  .Columns("A:A").ColumnWidth = 3       '列宽Columns('A:A' ). ColumnWidth = 15
  .Columns("B:B").ColumnWidth = 5
  .Columns("C:C").ColumnWidth = 5
  .Columns("D:D").ColumnWidth = 8.5
  .Columns("E:E").ColumnWidth = 31.5
  .Columns("F:F").ColumnWidth = 9
  .Columns("G:G").ColumnWidth = 5
  .Columns("H:H").ColumnWidth = 4.5
  .Columns("I:I").ColumnWidth = 3.5

Rows("1:1").RowHeight = 25.5    '行高Rows(' 1:5' ). RowHeight = 15
Rows("2:2").RowHeight = 35.1
Rows("3:3").RowHeight = 65.1
Rows("4:4").RowHeight = 45.95

Range("B4:C4 ").MergeCells = True                                        '合并B5-C5
Range("B5:C5 ").MergeCells = True                                        '合并B5-C5

If Range("A65536").End(xlUp).Row > 6 Then                      '复制5-6
Rows("5:5").Copy
Rows("6:" & Range("A65536").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteFormats    '选择剩余有内容的粘贴格式

Application.CutCopyMode = False

ActiveWorkbook.Save 保存修改
WB.Close 1 '保存文件直接关闭

      End If
      myFile = Dir '找寻下一个*.xls,或者xlsx文件

   Loop
      Set WB = Nothing '释放变量内存


End Sub

红色部分是遍历的代码，黑色部分是，我自己的代码，第一次运行提示
QQ截图20221122021655.jpg