Код не работает как `Add-In или Personal XLSB` [Тот же код отлично работает в книге, где он был создан]

Ниже код работает нормально и делает то, что я хочу. Но когда я использую это как Add-In работать на всех других книгах это говорит subscript out of range,

Может возникнуть путаница, связанная с объектом, или надстройка запутается, какую книгу использовать.

Я новичок в VBA и прошу всех вас помочь.

 Sub mac_3()
 Dim xlsname As String


Dim d As VbMsgBoxResult: d = MsgBox("Would you like to add record?" & vbNewLine & vbNewLine & "(Esc/Cancel to add something.)", vbYesNoCancel + vbQuestion, "Details!")
If d = vbNo Then
    Sheets("MPSA").Range("a13").Value = "Record is not available."
    Sheets("MPSA").Range("a13").Font.Bold = True
    ActiveWorkbook.Save
    GoTo savefile
    Exit Sub
End If
If d = vbCancel Then
    Dim myValue As Variant
    myValue = Application.InputBox("Non-Transactional number!", "Please paste number[separate with comma ,]:")
    If myValue = False Then
    Exit Sub
    Else
    Sheets("MPSA").Range("a13").Value = "Dataot available for : " & myValue
    Sheets("MPSA").Range("a13").Font.Bold = True
    ActiveWorkbook.Save
    GoTo savefile
    Exit Sub
    End If
End If

On Error GoTo Cleanup
Application.DisplayAlerts = False: Application.EnableEvents = False: Application.ScreenUpdating = False

Sheets("MPSA").Range("a14:ac14").Value = Array( _
"ACCOUNT NAME", " ACCOUNT NUMBER", "AGE", "ENTITY NAME", "GROUP", _
"ITEM NUMBER", "ITEM NAME", "COMPONENT", "QUANTITY", "SUBSCRIPTIONS", _
"QUANTITY", "QUANTITY", "NUMBER", "ITEM NAME", _
"PART NUMBER", "PART NAME", "EDITION", "TYPE", "VERSION", "USAGE", _
"LIMIT", "NAME", "TART DATE", "END DATE", "ASSET STATUS", _
"CATEGORY", "ACCOUNT TYPE", "METHOD", "CENTER")

Sheets("MPSA").Range("a14:ac14").Font.Name = "Calibri"
Sheets("MPSA").Range("a14:ac14").Interior.ColorIndex = 24
Sheets("MPSA").Range("a14:ac14").Font.Bold = True
Sheets("MPSA").Range("a14:ac14").Borders.LineStyle = xlContinuous
Sheets("MPSA").Columns.AutoFit


Dim Target_Path: Target_Path = Application.GetOpenFilename

Do While Target_Path <> False ' <-- loop until user cancels
    Dim Target_Workbook As Workbook: Set Target_Workbook = Workbooks.Open(Target_Path)

    Target_Workbook.Sheets(1).Cells.WrapText = True
    Target_Workbook.Sheets(1).Cells.WrapText = False

    Target_Workbook.Sheets(1).Range("A1").CurrentRegion.Offset(1).Copy _
        ThisWorkbook.Sheets("MPSA").Range("a1000000").End(xlUp).Offset(1)
    Target_Workbook.Close False

    ActiveWorkbook.Save
Dim e As VbMsgBoxResult: e = MsgBox("Another Record?", vbYesNo + vbQuestion, "Next details!")
    If e = vbNo Then
    ThisWorkbook.Save
    GoTo savefile
    Exit Sub
    End If
    'If e = vbYes Then

 Target_Path = Application.GetOpenFilename    
 Loop    
 GoTo savefile

 savefile:
 Application.DisplayAlerts = False    
 xlsname = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & "\Desktop\New Folder\" & xlsname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

 Cleanup:
If Err.Number <> 0 Then MsgBox "Something went wrong: " & vbCrLf & Err.Description
Application.DisplayAlerts = True: Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub

1 ответ

Решение

Проблема решена сейчас. По предложению @Tom, надстройка не понимала, в какой лист вставлять значения.

Ну, я определил другую переменную, используя Dim Source_Workbook as WorkbookSet Source_Workbook as ActiveWorkbook

Всем спасибо:)

Другие вопросы по тегам