首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >打开VBA Excel wb.Close/wb.Open

打开VBA Excel wb.Close/wb.Open
EN

Stack Overflow用户
提问于 2018-03-08 21:08:03
回答 1查看 394关注 0票数 0

我不太愿意在这里问这个问题,但很快就不会有头发了。我有一个访问数据库,会员办公室保持最新。我在这里引用对这些数据的查询。

成员资格保存每个章节的报告,此报表处理从active现有的活动章节报告中抓取Excel覆盖表(xlsx)和副本(xls)选项卡,然后将其放入查询序列,然后将工作簿保存为PDF。并不是每个章节都有相同的报告,更不用说每次运行报告了,所以到目前为止,我对这种方法感到满意,至少在概念上是这样的。

我在寻求帮助--诚然,我不是一个好的程序员,但我喜欢学习。所有的建议欢迎-关于我认为是一个访问或特权问题,移动到和excel的章节。从概念上讲,如果我不操作文件,或者我只有一个活动章节,它就会工作得很好。当它抓住第二章的值,并在处理第一章后循环。Set arWb = Workbooks.Open(FileName:=rptPathFile,ReadOnly:=True)似乎没有发生--在mnpltRpts()中失败了。

代码语言:javascript
复制
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

我在紧闭的/开放的线程上看了很多东西,并且已经做了一段时间了,但是以我的经验水平,我认为我可以从另一双眼睛中受益。我期待着你的建议。谢谢!

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2018-03-08 23:17:24

我认为您需要指定工作表的工作簿(“Sheet1”)。如果在Private ()中使用变量wb作为工作簿,如下所示:私有子mnpltRpts(wb作为工作簿),然后使用wb.sheets("Sheet1"),它可能会有所帮助。

编辑:所以在循环中,使用以下内容:

Call mnpltRpts(arWb)

并将潜艇改为:

代码语言:javascript
复制
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

在本例中,我认为工作表将在新文件中移动并重命名。如果需要在源文件中移动和重命名,则如下所示:

代码语言:javascript
复制
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 Sub
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/49182474

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档