VBA模块在userform中调用diff sheet

时间:2014-11-07 03:02:18

标签: excel-vba vba excel

new,想问一下是否有人可以查看我的代码,看看我犯了哪个错误。

首先,我创建了一个包含两个文本框和两个按钮的表单,这两个按钮将获取两个不同的目录和相关文件。这是通过调用将dir加载到文本框的函数来完成的。

用于调用函数以导航dir并获取文件的按钮

Private Sub CommandButton3_Click()
'call selectFile function to select file
selectFile
End Sub

将工作簿放入文本框1和2的功能:

Public Function selectFile()
Dim fileNamePath1 As String
Dim fileNamePath2 As String
Dim workbookFilePath1 As String
Dim workbookFilePath2 As String
    
On Error GoTo exit_
    
If workbookFilePath1 = Empty And workbookFilePath2 = Empty Then
    fileNamePath1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 1", MultiSelect:=False)
    workbookFilePath1 = Dir(fileNamePath1)
    'TextBox1.Text = workbookFilePath1
    TextBox1.Value = fileNamePath1
    
    fileNamePath2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 2", MultiSelect:=False)
    workbookFilePath2 = Dir(fileNamePath2)
    TextBox2.Value = fileNamePath2
    
    If fileNamePath1 = False Or fileNamePath2 = False Then
        MsgBox ("File selection was canceled.")
        Exit Function
    End If
    
End If

exit_:
End Function

到目前为止,代码还可以......可以做得更好,但是 这里出现问题...我想将目录作为对象传递到模块中以进行差异

执行模块到diff的

按钮:

Private Sub CommandButton1_Click()
    getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub

我知道我已经将myPath1和myPath2更改为Workbooks,我之前已将它们作为字符串

差异模块

Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
Dim myExcelObj
Dim WorkbookObj1
Dim WorkbookObj2
Dim WorksheetObj1
Dim WorksheetObj2

Dim file1 As String
Dim file2 As String
Dim myWorksheetCounter As Integer
Dim i As Worksheet

Set myExcelObj = CreateObject("Excel.Application")
myExcelObj.Visible = True

Set file1 = Dir(myPath1)
Set file2 = Dir(myPath2)

Set WorkbookObj1 = myExcelObj.Workbooks.Open(file1)
Set WorkbookObj2 = myExcelObj.Workbooks.Open(file2)
Set NewWorkbook = myExcelObj.Workbooks.Add

While WorkbookObj1 <> Null And WorkbookObj2 <> Null
'While WorkbookObj1.ActiveWorkbook.Worksheets.count = WorkbookOjb2.ActiveWorkbook.Worksheets.count
    myWorksheetCounter = ActiveWorkbook.Worksheets.count
    myWorksheetCount = ActiveWorkbook.Worksheets.count
    If WorksheetObj1.Worksheets.myWorksheetCounter = WorkbookObj2.Worksheets.myWorksheetCounter Then
        Set WorksheetObj1 = WorkbookObj1.Worksheets(myWorksheetCounter)
        Set WorksheetObj2 = WorkbookObj2.Worksheets(myWorksheetCounter)
        Set myNewWorksheetObj = NewWorkbook.Worksheets(myWorksheetCounter)

        For myWorksheetCounter = i To WorksheetObj1
            For myWorksheetCount = j To WorksheetOjb2
                'If cell.Value myWorksheetObj2.Range(cell.Address).Value Then
                If cell.Value = myWorksheetObj2.Range(cell.address).Value Then
                    myNewWorksheetObj.Range(cell.address).Value = cell.address.Value
                    myNewWorksheetObj.Range(cell.address).Interior.ColorIndex = 3
                Else
                    cell.Interior.ColorIndex = 0
                End If
            Next
                    
            'if doesn't work... use SaveChanges = True
            myNewWorksheetObj.Workbooks.Save() = True
                    
        Next
    Else
        MsgBox ("The worksheets are not the same worksheets." & vbNewLine & "Please try again.")
    End If
Wend

Set myExcelObj = Nothing
    
End Sub

所以我的问题是......有人可以帮忙看看我哪里出错了吗?基本上,我在试图让这个工作有一些问题。 非常感谢

我已经完成并清理了一些区域...但是现在有一个:“运行时错误'438':对象不支持这个问题或方法”在while循环代码我'我用

更新了帖子

1 个答案:

答案 0 :(得分:0)

我在CommandButton1_Click

上看到一个拼写错误
Private Sub CommandButton1_Click()
    getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub


Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)

可能会有更多内容,但是你没有把getThe中的“T”大写,但你这样称呼它。