代码不能用作“加载项或个人 XLSB”[相同的代码在创建它的工作簿中工作正常]
Code not working as `Add-In or Personal XLSB` [The same code works fine in workbook where it was created]
下面的代码运行良好,正在做我想做的事情。但是当我在所有其他工作簿上将它用作 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
问题已解决。正如@Tom 所建议的,Add-In 对将值粘贴到哪个工作表感到困惑。
好吧,我使用 Dim Source_Workbook as Workbook
Set Source_Workbook as ActiveWorkbook
定义了另一个变量
感谢大家:)
下面的代码运行良好,正在做我想做的事情。但是当我在所有其他工作簿上将它用作 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
问题已解决。正如@Tom 所建议的,Add-In 对将值粘贴到哪个工作表感到困惑。
好吧,我使用 Dim Source_Workbook as Workbook
Set Source_Workbook as ActiveWorkbook
感谢大家:)