[英]Call one subroutine from another
我正在尝试取消合并和复制xlsx文件文件夹的数据。
另外,两个宏均按预期工作。 当我组合宏(通过“调用”)时,它会执行,但随后又带我回到宏屏幕。 它没有给我任何错误,但是我需要关闭excel才能重新开始。
我猜想“ UnMergeFill”宏不能很好的自动打开吗?
我试过使用“通话”,也只是使用子名称。 我还尝试将潜艇分成不同的模块。
Sub AllWorkbooks()
Dim MyFolder As String
Dim MyFile As String
Dim wbk As Workbook
On Error Resume Next
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\"
End With
MyFile = Dir(MyFolder)
Do While MyFile <> “”
Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
UnMergeFill
wbk.Close savechanges:=True
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Call Sub UnMergeFill()
Dim cell As Range, joinedCells As Range
For Each cell In ThisWorkbook.ActiveSheet.UsedRange
If cell.MergeCells Then
Set joinedCells = cell.MergeArea
cell.MergeCells = False
joinedCells.Value = cell.Value
End If
Next
End Sub
'''
尝试这个:
Sub AllWorkbooks()
Dim MyFolder As String
Dim MyFile As String
Dim wbk As Workbook
On Error Resume Next
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\"
End With
MyFile = Dir(MyFolder)
Do While MyFile <> “”
Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
Call UnMergeFill(wbk)
wbk.Close savechanges:=True
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub UnMergeFill(wb As Workbook)
Dim cell As Range, joinedCells As Range
For Each cell In wb.ActiveSheet.UsedRange
If cell.mergeCells Then
Set joinedCells = cell.MergeArea
cell.mergeCells = False
joinedCells.Value = cell.Value
End If
Next
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.