Excel 충돌 및 매크로 때때로 작동하지 않는 경우가 있음


0

Excel VBA 매크로와 특정 열을 필터링하고 해당 열을 PDF로 필터링하여 내보내는 양식을 만들었습니다.

양식은 아래 이미지와 같습니다.

여기에 이미지 설명을 입력하십시오

아래는 코드입니다.

Private Sub ExportBtn_Click()


On Error GoTo errHandler



'remove previous autofilter

If ActiveSheet.AutoFilterMode Then
Cells.AutoFilter
End If

Dim strPath As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = Application.DefaultFilePath
    If .Show = 0 Then
        Exit Sub
    Else
        sItem = .SelectedItems(1)
        GoTo NextCode
    End If

End With
NextCode:
    strPath = sItem
    Set fldr = Nothing



Dim X
Dim objDict As Object
Dim lngRow As Long
Dim Temp As String
Dim wsA As Worksheet
Dim wbA As Workbook
Dim HeaderRange As Range
Set HeaderRange = Range(Cells(1, 1), Cells(1, 1).End(xlToRight))
Dim FilterRange As Range
For Each Cell In HeaderRange
    If Cell.Value Like "*" & ColumnListCombo.Value & "*" Then
    Cell.Select
    End If
Next

MyRow = ActiveCell.Row
MyCol = ActiveCell.Column

Set objDict = CreateObject("Scripting.Dictionary")
X = Application.Transpose(Range(Cells(2, MyCol), Cells(Rows.Count, MyCol).End(xlUp)))

For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1

Next

Dim FeederRange As Range
Set FeederRange = Range(Cells(2, MyCol), Cells(Rows.Count, MyCol).End(xlUp))
For Each Key In objDict.keys
    Range("A1").AutoFilter Field:=MyCol, Criteria1:=Key

    Dim strFile As String
    Dim strPathFile As String
    Dim StrLeftHeader As String
    Dim StrMidHeader As String
    Dim StrRightHeader As String
    Dim LeftHeaderCol As Integer
    Dim MidheaderCol As Integer

   ' Get Valuse from ExportForm Comboboxes
    For Each Cell In HeaderRange
    If Cell.Value = LefHeaderCBX.Value Then
        LeftHeaderCol = Cell.Column
    End If
    Next

    For Each Cell In HeaderRange
    If Cell.Value = MiddleheaderCBX.Value Then
        MidheaderCol = Cell.Column
    End If
    Next

    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet

    'replace spaces and periods in sheet name
     'StrLeftHeader = Range(Cells(2, LeftHeaderCol), Cells(Rows.Count, MyCol).End(xlUp)).offset(0, -1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
    If Not LeftHeaderCol = 0 Then
        StrLeftHeader = Range(Cells(2, LeftHeaderCol), Cells(Rows.Count, LeftHeaderCol).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
    Else
        StrLeftHeader = ""
    End If
    If Not MidheaderCol = 0 Then
        StrMidHeader = Range(Cells(2, MidheaderCol), Cells(Rows.Count, MyCol).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
    Else
        StrMidHeader = ""
    End If

    ' setting Headers and footers
   With wsA.PageSetup
       .LeftHeader = " &B " & LeftheaderPreTBX.Value & " " & StrLeftHeader
       .CenterHeader = " &B " & MidheaderPreTBX.Value & " " & StrMidHeader
       .RightHeader = " &B  " & RightheaderPreTBX.Value & " " & Key

       .LeftFooter = "&B RAPDRP-Change Management"
       .CenterFooter = " &B Advantage One Technologies Consulting Pvt Ltd."

       .RightFooter = " &B Page &P of &N"
     '   'Page &[Page] & of  &[Pages]
    End With

    NameFrstPart = Replace(LeftheaderPreTBX.Value & StrLeftHeader, "/", "-")
    NamescndPart = Replace(MidheaderPreTBX.Value & StrMidHeader, "/", "-")
    strFile = NameFrstPart & NamescndPart & Replace(Key, "/", "-")
    strPathFile = strPath & "/" & strFile

    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strPathFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

Next

ActiveSheet.ShowAllData
ActiveSheet.AutoFilterMode = False

exitHandler:
    Exit Sub
errHandler:
    Debug.Print "Error number: " & Err.Number _
            & " " & Err.Description
    Resume exitHandler


End Sub

어디에서 충돌합니까? 오류 메시지는 무엇입니까?
DavidPostill

오류 메시지 없음 "Excel이 작동을 멈췄습니다"라는 메시지가 표시되고 모든 것이 사라졌습니다. 일부는 완전히 작동하고 일부는 시간이 지남에 따라 작동하지 않습니다.
Akhil Kumar

당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.