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.