2017-08-25 151 views
-1

我正在制定一個標準的「書籍1,工作表1」工作簿,將在我完成時重命名。Excel VBA在多個工作簿中設置變量

我有一個主工作簿,此工作簿中的工作表將包含由用戶鍵入的信息。信息有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 
+1

請參見[如何避免使用選擇](https://stackoverflow.com/questions/10714251/how-to-avoid -use-select-in-excel-vba-macros) - 你永遠不應該有理由使用'Select'或者'Activate',除非它純粹是爲了像在特定表單上結束子的用戶界面原因。刪除它們會使你更清楚地觸發潛艇,更容易調試和維護,並且更加健壯。 – Wolfie

+1

嘗試將'Usr'和'lct'聲明爲'Range'和'Pctr'作爲'String'。 –

+0

你究竟是什麼*卡在*上?什麼是錯誤?這是什麼代碼沒有做你想要它做的?請更清楚地知道哪些代碼在哪個工作簿中... – Wolfie

回答

0

我知道我在回答我自己,但是我從任何一方都得到了很多幫助。

這是我幾乎最終的代碼,它正在處理多個工作簿和一切。

我還沒有納入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被要求,如果不保存,只是名字 - 發現計算器

此信息

另一個問題是如何合併圖片。括號是需要的pctr,即使沒有括號是需要的文件路徑。

作品完美...謝謝計算器和感謝莫扎特的耐心......

1

我不能確定你的tst子是爲了實現,但修改後的你的其他潛艇表現出一些更好的編碼實踐以及如何傳遞變量之間。

請參閱代碼註釋的詳細信息。

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