Question

我正在制作标准书＃1;第1册，第1页和第34页;工作簿，将在我完成后重命名。

我有一个主工作簿，此工作簿中的工作表将包含用户输入的信息。信息分为3部分：用户ID，图片位置，保存位置。

这是我目前正在使用的代码。

Sub Export_To_PDF()

Dim WBName, filepath, Filepth As String
WBName = ActiveWorkbook.Name

Filepth = Workbooks("Book1.xlsx").Sheets("Sheet1").Range("B4").Value

filepath = Filepth & "\" & WBName & ".pdf"

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filepath, _
Quality:=xlQualityMinimum, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

End Sub

Sub Macro1()


Sheets("Balancing Summary").Select
Range("E24").Select
ActiveCell.FormulaR1C1 = "A1111"
Range("E26").Select
ActiveSheet.Pictures.Insert("C:\Users\a1111\Music\ThePicture.jpg").Select
ChDir "C:\Users\a1111\Documents\Done"

Call Export_To_PDF

End Sub

Sub DoAll()

Workbooks("Book1.xlsx").Activate

Dim wbkX As Workbook
For Each wbkX In Application.Workbooks
wbkX.Activate 
Call Macro1
Next wbkX

End Sub

代码获取在单元格B4中键入的地址并将文档保存在那里。我需要为图片做同样的事情。图片的地址将在Book1，Sheet 1，B3中输入。我需要以下行没有地址，但是在运行宏时，请参考该书和工作表中的特定单元格。

ActiveSheet.Pictures.Insert("C:\Users\a1111\Music\ThePicture.jpg").Select

将打开多个工作簿和工作表，因此必须指定正确的工作簿和工作表。

我需要与下面的行类似地完成

Filepth = Workbooks("Book1.xlsx").Sheets("Sheet1").Range("B4").Value

Answer 1

我不确定你的tst sub要达到什么目的，但修改了你的其他潜艇以显示更好的编码实践以及如何在潜艇之间传递变量。

请参阅代码注释以获取详细信息。

Sub Macro1(wb As Workbook)
    ' Avoid using Select by using With 
    With wb.Sheets("Balancing Summary")
        .Range("E24").FormulaR1C1 = "A1111"
        .Range("E26").Pictures.Insert("C:\Users\a1111\Music\ThePicture.jpg")
        ' you can call Subs just by using their name, no need for Call
        ' Also passing arguments to subs can be done like so
        Export_To_PDF WBName:=wb.Name, path:="C:\Users\a1111\Documents\Done"
    End With
End Sub

Sub Export_To_PDF(WBName As String, path As String)
    ' Pass the path and workbook name into this function
    Dim FilePath As String
    FilePath = path & "\" & WBName & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=FilePath, Quality:=xlQualityMinimum, _ 
                                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

Sub DoAll()
    ' Loop over workbooks, pass the workbook object to Macro1
    Dim wbkX As Workbook
    For Each wbkX In Application.Workbooks
        Macro1 wb:=wbkX 
    Next wbkX
End Sub

Answer 2

我知道我在回答自己，但无论如何我都得到了很多帮助。

这是我几乎最终的代码，它正在处理多个工作簿和所有内容。

我还没有纳入Wolfie的建议，虽然我会这样做，只是想这么久回答这个问题。

这是我现在结束的代码。

Sub Macro1()

Dim filepth As String
Dim Pctr As String
Dim Usr As String
filepth = Workbooks("Book1.xlsx").Sheets("Sheet1").Range("B4").Value
Pctr = Workbooks("Book1.xlsx").Sheets("Sheet1").Range("B3").Value
Usr = Workbooks("Book1.xlsx").Sheets("Sheet1").Range("B2").Value

Sheets("Balancing Summary").Select
Range("E24").Select
ActiveCell.FormulaR1C1 = Usr
Range("E26").Select
ActiveSheet.Pictures.Insert(Pctr).Select
ChDir filepth
Call Export_To_PDF

End Sub


Sub Export_To_PDF()

Dim WBName, filepath, filepth As String
WBName = ActiveWorkbook.Name

filepth = Workbooks("Book1.xlsx").Sheets("Sheet1").Range("B4").Value

filepath = filepth & "\" & WBName & ".pdf"

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filepath, _
Quality:=xlQualityMinimum, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

End Sub


Sub DoAll()

Workbooks("Book1.xlsx").Activate

Sheets("Balancing Summary").Visible = True
Sheets("Adj. Sheet 3").Visible = True
Sheets("Sheet1").Select

Dim wbkX As Workbook
For Each wbkX In Application.Workbooks
wbkX.Activate 
Call Macro1
Next wbkX

Call Sve

End Sub

我遇到的最大问题是引用工作簿名称，如果保存工作簿，则需要.xlsx，如果没有保存，只需要名称 - 在stackoverflow上找到此信息

另一个问题是如何整合图片。 pctr需要括号，即使文件路径不需要括号。

完美运作...感谢stackoverflow并感谢Wolfie的耐心......

Excel VBA在多个工作簿上设置变量

2 个答案: