Excel VBA - 改进全局变量使用的技巧

Question

我们正在创建一个 Excel VBA 程序来创建文件夹和 word/excel 文档。 主程序将调用 subs（创建文件夹、创建单词、创建 excel），但我也希望 subs 能够在没有主程序启动它们的情况下自行处理/记住变量。

问题/问题：有没有比在每个子例程中放置 SÖKVÄG_UPPDRAG = "G:\Administrativt\Automattillverkning av dokument\Zebastian" 更好的方法来重新初始化变量 SÖKVÄG_UPPDRAG 的值？变量 PROJ_NR、PROJ_BENÄMNING 也是如此。

因为如果我删除该行，当我尝试在独立情况下调用它时，子例程会为该变量返回值 0。

Option Explicit

Public PROJ_NR As Integer
Public PROJ_BENÄMNING, SÖKVÄG_UPPDRAG, SÖKVÄG_PROJEKT As String
Public DATUM_LEV As Date

Public Sub ABE_Master()

Application.ScreenUpdating = False 'stänger av uppdatering av skärmen
Application.Calculation = xlCalculationManual 'stänger av omkalkyleringar

Call SKAPA_MAPP
Call SKAPA_WORD
Call SKAPA_CHECKLISTA

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub


Public Sub SKAPA_MAPP()

PROJ_NR = Range("PROJ_NR").value
PROJ_BENÄMNING = Range("PROJ_BENÄMNING").value
DATUM_LEV = Range("DATUM_LEV").value

SÖKVÄG_UPPDRAG = "G:\Administrativt\Automattillverkning av dokument\Zebastian"
SÖKVÄG_PROJEKT = DATUM_LEV & "_" & PROJ_NR & "_" & PROJ_BENÄMNING

If Len(Dir(SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT, vbDirectory)) > 0 Then

MsgBox "Uppdragsmapp finns redan, inga åtgärder utförda", vbInformation, ""
    Exit Sub
End If

MkDir SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT
MkDir SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & "\" & "Mail"
MkDir SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & "\" & "Underlag"
MkDir SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & "\" & "Leverans " & "[" & Year(Date) & "]-xx-xx"

End Sub

Public Sub SKAPA_CHECKLISTA()

PROJ_NR = Range("PROJ_NR").value
PROJ_BENÄMNING = Range("PROJ_BENÄMNING").value
DATUM_LEV = Range("DATUM_LEV").value

SÖKVÄG_UPPDRAG = "G:\Administrativt\Automattillverkning av dokument\Zebastian"
SÖKVÄG_PROJEKT = DATUM_LEV & "_" & PROJ_NR & "_" & PROJ_BENÄMNING

If Len(Dir(SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & "\" & PROJ_NR & "_" & PROJ_BENÄMNING & 
"_Checklista.xlsm", vbNormal)) > 0 Then

MsgBox "Checklista finns redan, inga åtgärder utförda", vbInformation, ""
    Exit Sub
End If

Dim Wb As Workbook
Set Wb = Workbooks.Add
Wb.SaveAs Filename:=(SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & "\" & PROJ_NR & "_" &         
PROJ_BENÄMNING & "_Checklista.xlsm"), FileFormat:=52
Wb.Close


End Sub

Answer 1

@SiddharthRout 在公共子 SKAPA_MAPP 和 SKAPA_WORD 下，我运行 If 语句以在创建文件之前检查文件是否已存在。如您所见，我必须在所有子例程中声明变量 PROJ_NR = Range("PROJ_NR").value。是否可以清理代码并只声明一次？ – MrWZY 16 分钟前

没有。由于它不是一个常数，你不能做像Public Const PROJ_NR As Variant = Range("PROJ_NR").Value 这样的事情但是你可以创建一个通用函数来检查路径是否存在。请参阅此示例。

您的代码可以简化为 (UNTESTED)

Option Explicit

Public Const SÖKVÄG_UPPDRAG As String = "G:\Administrativt\Automattillverkning av dokument\Zebastian"
Public SÖKVÄG_PROJEKT As String
Public NewFileName As String

Public Sub ABE_Master()
    Application.ScreenUpdating = False 'stänger av uppdatering av skärmen
    Application.Calculation = xlCalculationManual 'stänger av omkalkyleringar
    
    Call SKAPA_MAPP
    'Call SKAPA_WORD
    Call SKAPA_CHECKLISTA
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Public Sub SKAPA_MAPP()
    If DoesPathExist = True Then Exit Sub
    
    MkDir SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT
    MkDir SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & "\" & "Mail"
    MkDir SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & "\" & "Underlag"
    MkDir SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & "\" & "Leverans " & "[" & Year(Date) & "]-xx-xx"
End Sub

Public Sub SKAPA_CHECKLISTA()
    If DoesPathExist = True Then Exit Sub
    
    Dim Wb As Workbook
    Set Wb = Workbooks.Add
    
    Wb.SaveAs Filename:=(SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT & NewFileName), FileFormat:=52
    Wb.Close
End Sub

Public Function DoesPathExist() As Boolean
    Dim ws As Worksheet
    Dim PROJ_NR As Integer
    Dim PROJ_BENÄMNING As String
    Dim DATUM_LEV As Date
    
    Set ws = Sheet1
    
    PROJ_NR = ws.Range("PROJ_NR").Value
    PROJ_BENÄMNING = ws.Range("PROJ_BENÄMNING").Value
    DATUM_LEV = ws.Range("DATUM_LEV").Value
    
    SÖKVÄG_PROJEKT = DATUM_LEV & "_" & PROJ_NR & "_" & PROJ_BENÄMNING
    
    If Len(Dir(SÖKVÄG_UPPDRAG & "\" & SÖKVÄG_PROJEKT, vbDirectory)) > 0 Then
        MsgBox "Uppdragsmapp finns redan, inga åtgärder utförda", vbInformation, ""
        DoesPathExist = True
    Else
        NewFileName = "\" & PROJ_NR & "_" & PROJ_BENÄMNING & "_Checklista.xlsm"
    End If
End Function