btraemoore 发表于 2022-7-6 22:29:28

从中保存为问题

我试图将我所做的工作另存为一个不同的文件名，我不断得到“脚本超出范围”有人能扔我一根骨头吗？
 
' Declare Working Directory
   Global Const WrkDir = "C:\Documents and Settings\moorerb\Desktop\asset worksheets\"
' Declare Excel Workbook name
   Global Const Master_WorkBook = WrkDir & "bptags.xls"
   Global Const Secondary_WorkBook = WrkDir & "mytemp.xls"
' Declare Excel Worksheet name
   Global Const Master_WorkSheet = "ccu3"
   Global Const Secondary_WorkSheet = "mytemp"
   

Global workbooks As Object
Global ExcelVer As Integer
Global ExcelServer As Object
Global ObjWorksheet As Object
'Global SecWorksheet As Object
'Global ObjWorkbook As Object
Global FileSaveName As String
' end of global variables


Sub RetrieveEXC()
   Set ExcelServer = CreateObject("Excel.Application.11")
       Set workbooks = ExcelServer.workbooks
       workbooks.Add ("C:\Documents and Settings\moorerb\Desktop\asset worksheets\mytemp.xls")
       workbooks.Open (Master_WorkBook)
      
   Set ObjWorksheet = ExcelServer.ActiveWorkbook.worksheets(Master_WorkSheet)
       'ExcelServer.WindowState = -4140
       ExcelServer.Visible = True
      
       FileSaveName = WrkDir & Dwg_Name & ".xls"
       'Set SecWorksheet = ExcelServer.ActiveWorkbook.worksheets(Secondary_WorkSheet)

                   the line below is where my issue lyes.
       workbooks(Master_WorkBook).Sheets(Secondary_WorkSheet).Move After:=workbooks(Secondary_WorkBook).Sheets(1)
       workbooks(Secondary_WorkBook).SaveAs FileSaveName, fileformat:=56
      
       set_to_null
'----------------------------------------------
       ActiveWorkbook.SaveAs FileName:= _
       FileSaveName, fileformat:= _
       xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
       , CreateBackup:=False
'----------------------------------------------      
End Sub
 
这些是我的手表
 

btraemoore 发表于 2022-7-6 23:50:12

只是为了更新，这是工作代码
 
'
' work done in excel
'

Sub excelwork()
   Dim i As Integer, n As Long, c As Long
       c = 8
   Dim CurrentItem As String
   Dim pause As Boolean
   Dim match As Variant
   Dim NewSheetName As String
       NewSheetName = Dwg_Name & "assets"
      
   'set a count for items in collection
   For i = 1 To EOC
   Cur_TxtSTR = text_coll(i)
   MasWorksheet.Activate
   MasWorksheet.cells(1, 3).Activate
   
       'set a count for items in excel spreadsheet
       For n = 1 To 876
       CurrentItem = MasWorksheet.cells(n, 3).Value
         
         'compare collection item to each excel item, until we find our match
         If Cur_TxtSTR = CurrentItem Then
               MasWorksheet.Rows(n).Select                ' select the row
               MasWorksheet.Rows(n).Copy                  ' copy the row
               secWorksheet.Activate
               secWorksheet.cells(c, 1).Activate
               secWorksheet.paste                         ' paste the row in the new sheet
               secWorksheet.cells(c, 10).Value = Dwg_Name ' insert the drawing name in new sheet
               c = c + 1
         End If
   
       Next n
      
   Next i
   
   secWorksheet.Copy ' copy the new sheet
   ExcelServer.activeworkbook.sheets("template").Name = NewSheetName ' set the new sheet name
   FileSaveName = ExcelServer.Application.GetSaveAsFilename _
   (InitialFileName:=Dwg_Name & ".xls", Title:="Save As")            ' choose where we're going to save it
   
   If FileSaveName = "False" Then                         ' error handleing
       MsgBox "File not Saved, Actions Cancelled."
       Exit Sub
   Else
       ExcelServer.activeworkbook.SaveAs FileSaveName ' save it
       ExcelServer.activeworkbook.Close               ' close it
   End If
   
   ExcelServer.Application.DisplayAlerts = False ' hide unwanted alerts
   ExcelServer.workbooks("bptags.xls").Close   ' close the work book
   ExcelServer.Quit                              ' quit excel
   set_to_nil                                    ' function to reset object variables to nothing
   
End Sub

 
这是我的博客，可以随意访问并查看或更正
http://showyourcode.blogspot.com/
页: [1]
查看完整版本: 从中保存为问题