如何声明全局变量来访问vba中的其他函数?

时间:2012-10-26 10:44:47

标签: excel-vba vba excel

我在浏览按钮事件中浏览按钮变量和编码。现在我必须在另一个按钮事件中访问这些变量。如何在vba中声明?

private sub commandbutton1_click()
Dim someFileName As Variant
Dim folderName As String
Dim i As Integer
Const STRING_NOT_FOUND As Integer = 0

'select a file using a dialog and get the full name with path included
 someFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")

 If someFileName <> False Then

'strip off the folder path
folderName = vbNullString
i = 1

While STRING_NOT_FOUND < i
    i = InStr(1, someFileName, "\", vbTextCompare)  'returns position of the first       backslash "\"
    If i <> STRING_NOT_FOUND Then
        folderName = folderName & Left(someFileName, i)
        someFileName = Right(someFileName, Len(someFileName) - i)
    Else 'no backslash was found... we are done
        GetAFileName = someFileName

    End If
Wend

Else
GetAFileName = vbNullString
End If
end sub

private sub commandbutton2_click()

我必须在这里访问GetAFileName变量吗?

5 个答案:

答案 0 :(得分:2)

这将是您必须使用的结构:

Option Explicit
private GetAFileName as string

private sub commandbutton1_click()
  Dim some As Variant
  some = "test2"
  GetAFileName = some
end sub

private sub commandbutton2_click()
  MsgBox GetAFileName
end sub

您必须在功能之外定义此GetAFileName,以便从这两个功能中进行访问。

顺便说一下 - 您应该使用option explicit来确保每个变量在某个地方都有明确的定义。

答案 1 :(得分:1)

使用enter code here全局VARNAME

实施例: &#39;运行此功能&#34; aaa&#34;并显示一个带有标题&#34; 1&#34;

的消息框
Global A
Function aaa()
    A = 1
    Call BBB
End Function

Function BBB()
    MsgBox (A)
End Function

希望有所帮助!

答案 2 :(得分:0)

Option Compare Database
Option Explicit

Public Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
pszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Const MAX_PATH As Long = 260
Const dhcErrorExtendedError = 1208&
Const dhcNoError = 0&

'通过常量指定浏览文件夹的根目录 '您还可以通过常量为可搜索的文件夹和选项指定值。

Const dhcCSIdlDesktop = &H0
Const dhcCSIdlPrograms = &H2
Const dhcCSIdlControlPanel = &H3
Const dhcCSIdlInstalledPrinters = &H4
Const dhcCSIdlPersonal = &H5
Const dhcCSIdlFavorites = &H6
Const dhcCSIdlStartupPmGroup = &H7
Const dhcCSIdlRecentDocDir = &H8
Const dhcCSIdlSendToItemsDir = &H9
Const dhcCSIdlRecycleBin = &HA
Const dhcCSIdlStartMenu = &HB
Const dhcCSIdlDesktopDirectory = &H10
Const dhcCSIdlMyComputer = &H11
Const dhcCSIdlNetworkNeighborhood = &H12
Const dhcCSIdlNetHoodFileSystemDir = &H13
Const dhcCSIdlFonts = &H14
Const dhcCSIdlTemplates = &H15

'用于限制BrowseForFolder对话框选项的常量

Const dhcBifReturnAll = &H0
Const dhcBifReturnOnlyFileSystemDirs = &H1
Const dhcBifDontGoBelowDomain = &H2
Const dhcBifIncludeStatusText = &H4
Const dhcBifSystemAncestors = &H8
Const dhcBifBrowseForComputer = &H1000
Const dhcBifBrowseForPrinter = &H2000

'...您可以从集成的API查看器中获取更多这些值以进行常规指定,或者转到AllPai.net并查看其样本。

Public Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long

“校正

Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, ByRef pidl As Long) As Long



Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

 Public Function BrowseForFolder(ByVal lngCSIDL As Long, _
 ByVal lngBiFlags As Long, _
 strFolder As String, _
 Optional ByVal hWnd As Long = 0, _
 Optional pszTitle As String = "Select Folder") As Long


Dim usrBrws As BROWSEINFO
Dim lngReturn As Long
Dim lngIDL As Long

If SHGetSpecialFolderLocation(hWnd, lngCSIDL, lngIDL) = 0 Then

'在这里设置浏览结构

With usrBrws
   .hwndOwner = hWnd
   .pidlRoot = lngIDL
   .pszDisplayName = String$(MAX_PATH, vbNullChar)
   .pszTitle = pszTitle
   .ulFlags = lngBiFlags
End With

'打开对话框

 lngIDL = SHBrowseForFolder(usrBrws)

 If lngIDL = 0 Then Exit Function

'如果成功

 If lngIDL Then strFolder = String$(MAX_PATH, vbNullChar)

   'resolve the long value form the lngIDL to a real path

   If SHGetPathFromIDList(lngIDL, strFolder) Then
       strFolder = Left(strFolder, InStr(1, strFolder, vbNullChar))
   lngReturn = dhcNoError 'to show there is no error.
   Else
       'nothing real is available.
       'return a virtual selection
       strFolder = Left(usrBrws.pszDisplayName, InStr(1, usrBrws.pszDisplayName, vbNullChar))
    lngReturn = dhcNoError 'to show there is no error.
    End If
Else
 lngReturn = dhcErrorExtendedError 'something went wrong
End If


BrowseForFolder = lngReturn

End Function

答案 3 :(得分:0)

Sub hth() 

With Application.FileDialog(msoFileDialogFolderPicker) 
    .AllowMultiSelect = False 
    .Show 

    If .SelectedItems.Count > 0 Then 
txt2.setfocus
        txt2.Text = .SelectedItems(1) 
    End If 

End With 

End Sub 

答案 4 :(得分:0)

Private Sub Command9_Click()
Call BrowseForFolder(dhcCSIdlDesktop, dhcBifReturnOnlyFileSystemDirs, _
STRPATH2, pszTitle:="Select a folder:")
If STRPATH2 <> "" Then
STRPATH2 = Left(STRPATH2, Len(STRPATH2) - 1)
Text7.Value = STRPATH2
'DoCmd.Close acForm, "frm_generate_report", acSaveNo
'DoCmd.OpenForm "frm_generate_report", acNormal
End If
End Sub