我不太愿意在这里问这个问题,但很快就不会有头发了。我有一个访问数据库,会员办公室保持最新。我在这里引用对这些数据的查询。
成员资格保存每个章节的报告,此报表处理从active现有的活动章节报告中抓取Excel覆盖表(xlsx)和副本(xls)选项卡,然后将其放入查询序列,然后将工作簿保存为PDF。并不是每个章节都有相同的报告,更不用说每次运行报告了,所以到目前为止,我对这种方法感到满意,至少在概念上是这样的。
我在寻求帮助--诚然,我不是一个好的程序员,但我喜欢学习。所有的建议欢迎-关于我认为是一个访问或特权问题,移动到和excel的章节。从概念上讲,如果我不操作文件,或者我只有一个活动章节,它就会工作得很好。当它抓住第二章的值,并在处理第一章后循环。Set arWb = Workbooks.Open(FileName:=rptPathFile,ReadOnly:=True)似乎没有发生--在mnpltRpts()中失败了。
Public strChptrName As String
Public strChptrTag As String
Public strFileCPT As String
Private Sub rptLoop()
Dim dbsChActv As DAO.Database
Dim rstActvRpts As DAO.Recordset
Dim rstActvChptrs As DAO.Recordset
Dim qryActvRpts As DAO.QueryDef
Dim qryActvChptrs As DAO.QueryDef
Set dbsChActv = CurrentDb
Set qryActvChptrs = dbsChActv.QueryDefs("query100ActvChptrs")
Set qryActvRpts = dbsChActv.QueryDefs("query120ActvRpts")
Set rstActvChptrs = qryActvChptrs.OpenRecordset()
Set rstActvRpts = qryActvRpts.OpenRecordset()
rptImpDir = "C:\ChapterProcess\Import\"
rptImpTyp = ".xls"
strFullFileCPT = "C:\ChapterProcess\PhonyCover.xlsx"
strFileCPT = "PhonyCover.xlsx"
cvrSheet = "CTSheetName"
rstActvChptrs.MoveFirst 'first Chptr from query100ActvChptrs
Do While Not rstActvChptrs.EOF And Not rstActvChptrs.BOF 'Chptr loop, outer
Dim xlCP As Excel.Application
Dim arWb As Workbook
Set xlCP = New Excel.Application
xlCP.Workbooks.Open strFullFileCPT 'open cover template
xlCP.Visible = True
prevSheet = cvrSheet 'set prevSheet to cvrSheet name of strFullFileCPT. prevSheet becomes other added sheet names as they are added to the workbook.
'depending on member items available, prevSheet is used for shuffling the tabs into report order seq query120ActvRpts
Do While Not rstActvRpts.EOF And Not rstActvRpts.BOF
rptPathFile = rptImpDir & LCase(rstActvChptrs![ChptrTag]) & " " & rstActvRpts![NameFile] & rptImpTyp
rptFile = LCase(rstActvChptrs![ChptrTag]) & " " & rstActvRpts![NameFile] & rptImpTyp
' Debug.Print rptPathFile
' Debug.Print rptFile
If Not Dir(rptPathFile, vbDirectory) = vbNullString Then
strChptrTag = UCase(rstActvChptrs![ChptrTag])
strChptrName = (rstActvChptrs![Chptr])
strReportTag = rstActvRpts![ReportTag]
Set arWb = Workbooks.Open(FileName:=rptPathFile, ReadOnly:=True)
Call mnpltRpts
arWb.Close False
prevSheet = rstActvRpts![ReportTag]
Debug.Print rptFile & " Accommodated"
Else
Debug.Print "No file: " & rptFile
rstActvRpts.MoveNext
End If
rstActvRpts.MoveNext
Loop
rstActvRpts.MoveFirst
rstActvChptrs.MoveNext
Call pdfRpt
ActiveWorkbook.Saved = True
xlCP.Quit
Set xlCP = Nothing
Loop
End Sub
Private Sub mnpltRpts()
Sheets("Sheet1").Select
'>>Look<< subsequent times through the loop fail here.
Sheets("Sheet1").Copy Before:=Workbooks(strFileCPT).Sheets(1)
'>>Look<< subsequent times through the loop fail here.
Sheets("Sheet1").Select
Sheets("Sheet1").Move After:=Sheets(prevSheet)
Call pgWidth
Sheets("Sheet1").Select
Sheets("Sheet1").Name = strReportTag
End Sub
Private Sub pgWidth()
On Error GoTo errHnd
Dim wkSht As Worksheet
Set wkSht = ActiveSheet
With wkSht.PageSetup
.Zoom = False
.FitToPagesTall = False
.FitToPagesWide = 1
End With
errHnd:
End Sub
Private Sub pdfRpt()
bsPath = "C:\ChapterProcess\"
expPath = "Export\"
pdfPath = "PDF\"
strFile = "ProcessingReport"
strDate = Format(Now(), "yyyymmddhhmm")
strExt = ".pdf"
expFileAll = bsPath & expPath & strDate & "_" & strChptrTag & "_" & strFile & strExt
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
expFileAll _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub我在紧闭的/开放的线程上看了很多东西,并且已经做了一段时间了,但是以我的经验水平,我认为我可以从另一双眼睛中受益。我期待着你的建议。谢谢!
发布于 2018-03-08 23:17:24
我认为您需要指定工作表的工作簿(“Sheet1”)。如果在Private ()中使用变量wb作为工作簿,如下所示:私有子mnpltRpts(wb作为工作簿),然后使用wb.sheets("Sheet1"),它可能会有所帮助。
编辑:所以在循环中,使用以下内容:
Call mnpltRpts(arWb)
并将潜艇改为:
Private Sub mnpltRpts(wb as Workbook)
wb.Sheets("Sheet1").Copy After:=Workbooks(strFileCPT).Sheets(prevSheet)
Call pgWidth
Workbooks(strFileCPT).Sheets("Sheet1").Name = strReportTag
End Sub在本例中,我认为工作表将在新文件中移动并重命名。如果需要在源文件中移动和重命名,则如下所示:
Private Sub mnpltRpts(wb as Workbook)
wb.Sheets("Sheet1").Copy Before:=Workbooks(strFileCPT).Sheets(1)
wb.sheets("Sheet1").Move After:=wb.sheets(prevSheet)
Call pgWidth
wb.Sheets("Sheet1").Name = strReportTag
End Subhttps://stackoverflow.com/questions/49182474
复制相似问题