創建函數以避免代碼重複

Question

我在Excel中有一些vba代碼來自動化Visio，我必須創建多個文本框。我現在做的是這樣的：

 Set textbox1 = vsoDocument.Pages(PageName).DrawRectangle(1,1,1,3) 
     textbox1.LineStyle = "Text Only" 
     textbox1.FillStyle = "Text Only" 
     textbox1.CellsSRC(visSectionParagraph, 0, visHorzAlign).FormulaU = "0" 'Align Left 
     textbox1.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "6 pt" 
     textbox1.Characters.Text = "Text goes here" 
     textbox1.Characters.CharProps(visCharacterStyle) = 17# 

但是我想這個移動功能，但我仍然需要有框能夠通過名稱來引用，我就可以在以後執行其他任務腳本。我試圖做一個函數來執行此：

Function AddTextBox(vName, x1, y1, x2, y2, align, tSize, textchar) 
    Set vName = vsoDocument.Pages(PageName).DrawRectangle(x1, y1, x2, y2) 
    vName.LineStyle = "Text Only" 
    vName.FillStyle = "Text Only" 
    vName.CellsSRC(visSectionParagraph, 0, visHorzAlign).FormulaU = align 
    vName.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = tSize 
    vName.Characters.Text = textchar 
End Function 

並把它稱爲是這樣的：

test = AddTextBox("textbox1", 1, 1, 1, 3, 0, "6 pt", "Text goes here") 

但是我得到424錯誤的「所需的對象」。我讀過的任何VBA函數似乎都被用來返回一個值，而不是用於避免重複代碼。

是否可以簡化我的代碼並防止用這種方法重複自己？

Answer 1

問題是您正在嘗試創建一個對象，但是您創建的對象正在作爲字符串傳入。做這樣的事情，而不是：

Dim oText as Object 
Function AddTextBox(oText, x1, y1, x2, y2, align, tSize, textchar) 
    Set oText= vsoDocument.Pages(PageName).DrawRectangle(x1, y1, x2, y2) 
    oText.LineStyle = "Text Only" 
    oText.FillStyle = "Text Only" 
    oText.CellsSRC(visSectionParagraph, 0, visHorzAlign).FormulaU = align 
    oText.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = tSize 
    oText.Characters.Text = textchar 
End Function 

這將允許您創建一個使用功能的文本框對象，但它提出了一個事實，即函數沒有返回任何值，因此實際上應該是一分。爲了解決這個問題，你可以做這樣的事情，而不是：

Function AddTextBox(x1, y1, x2, y2, align, tSize, textchar) 
     Set oText= vsoDocument.Pages(PageName).DrawRectangle(x1, y1, x2, y2) 
     oText.LineStyle = "Text Only" 
     oText.FillStyle = "Text Only" 
     oText.CellsSRC(visSectionParagraph, 0, visHorzAlign).FormulaU = align 
     oText.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = tSize 
     oText.Characters.Text = textchar 

     Set AddTextBox = oText 
    End Function 

，並調用它是這樣的：

Dim oText as Object 
Set oText = AddTextBox(x1, y1, y2, align, tSize, textchar) 

其中，函數的ARG遊戲，你想傳遞變量

每評論

修改後的代碼從OP：

Function AddTextBox(oText as Object, x1 as Long, y1 as Long, x2 as Long, y2 as Long, align, tSize as Long, textchar, PageName as String) as Boolean 
    If Not vsoDocument.Pages(PageName) is Nothing Then 
     Set oText= vsoDocument.Pages(PageName).DrawRectangle(x1, y1, x2, y2) 
     With oText 
      .LineStyle = "Text Only" 
      .FillStyle = "Text Only" 
      .CellsSRC(visSectionParagraph, 0, visHorzAlign).FormulaU = align 
      .CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = tSize 
      .Characters.Text = textchar 
    Else 
     AddTextBox = True 
    End If 
End Function 

你可以這樣稱呼它：

Dim oText as Object 
If Not AddTextBox(oText, x1, y1, y2, align, tSize, textchar, PageName) Then 
    If Not oText is Nothing Then 

     ' Just to test whether oText is set or not. 
    Else 
     Debug.Print "Error when setting oText" 
    End if 
Else 
    Debug.Print "vsoDocument.Pages(" & PageName & ") is not an object!" 
End If 

你肯定不需要這麼多如果塊，有處理這些如果該函數返回內，生病留給你來提煉一旦你的功能，雖然工作的更好的方法。只要確保你傳遞了一個有效的頁面名稱，並使用上面的示例來確保找到該對象。

Answer 2

通過將Visio文檔類型設置爲As Visio.Document解決了該問題。然後所有的問題都融化了。下面是最終功能：

Function AddTextBox(vd As Visio.Document, PageName, x1, y1, x2, y2, align, tSize, textchar) 
    Set vName = vd.Pages(PageName).DrawRectangle(x1, y1, x2, y2) 
    vName.LineStyle = "Text Only" 
    vName.FillStyle = "Text Only" 
    vName.CellsSRC(visSectionParagraph, 0, visHorzAlign).FormulaU = align 
    vName.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = tSize 
    vName.Characters.Text = textchar 
    Set AddTextBox = vName 
End Function 

它然後叫，像這樣：

Set TextBox1= AddTextBox(vsoDocument, Page1, 0.7, 8, 0.5, 8, 0, "6 pt", "Text goes here")