VBA是否可以不添加任何引用就有commdlg功能
VBA是否可以不添加任何引用(“Microsoft Common Dialog Control 6.0")就有commdlg功能，直接用代码来实现，或api函数,因为我设计的程式拿到别的电脑上用，别人老用不起来 --------------------编程问答-------------------- VBA不知道，vb这里有个别人写的类，直接拿过去用吧Option Explicit
' ==========================================================================
' Class: cCommonDialog
' Filename: cCommonDialog.cls
' Author: Steve McMahon
' Date: 24 May 1998
'
' A wrapper around GCommonDialog to make it look more
' like the standard common dialog control.
' ==========================================================================
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" (lpvDest As Any, _
lpvSource As Any, _
ByVal cbCopy As Long)
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage _
Lib "kernel32" _
Alias "FormatMessageA" (ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
Arguments As Long) As Long
Private Declare Function OleTranslateColor _
Lib "olepro32.dll" (ByVal OLE_COLOR As Long, _
ByVal HPALETTE As Long, _
pccolorref As Long) As Long
Private Declare Function SystemParametersInfo _
Lib "user32" _
Alias "SystemParametersInfoA" (ByVal uAction As Long, _
ByVal uParam As Long, _
lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Private Const SPI_GETWORKAREA = 48&
' Properties to emulate the CommonDialog control:
Private m_bCancelError As Boolean
Private m_sFilter As String
Private m_lFilterIndex As Long
Private m_sFileName As String
Private m_oColor As OLE_COLOR
Private m_lCopies As Long
Private m_lFlags As Long
Private m_sDialogTitle As String
Private m_sDefaultExt As String
Private m_Font As New StdFont
Private m_oFontColor As OLE_COLOR
Private m_lFromPage As Long
Private m_lhWnd As Long
Private m_eHelpCommand As EShowHelpCommands
Private m_sHelpContext As String
Private m_sHelpFile As String
Private m_sHelpKey As String
Private m_sInitDir As String
Private m_lMax As Long
Private m_lMaxFileSize As Long
Private m_lMin As Long
Private m_objObject As Object
Private m_iPrinterDefault As Integer
Private m_lToPage As Long
Private m_sFileTitle As String
Private m_hDC As Long
Private m_bHookDialog As Boolean
Private mCommonDialog As New GCommonDialog
'API function inside ShowHelp method
Private Declare Function WinHelp _
Lib "user32" _
Alias "WinHelpA" (ByVal hWnd As Long, _
ByVal lpHelpFile As String, _
ByVal wCommand As Long, _
ByVal dwData As Long) As Long
' WinHelp Commands:
Public Enum EShowHelpCommands
HELP_COMMAND = &H102&
HELP_CONTENTS = &H3&
HELP_CONTEXT = &H1 ' Display topic in ulTopic
HELP_CONTEXTPOPUP = &H8&
HELP_FORCEFILE = &H9&
HELP_HELPONHELP = &H4 ' Display help on using help
HELP_INDEX = &H3 ' Display index
HELP_KEY = &H101 ' Display topic for keyword in offabData
HELP_MULTIKEY = &H201&
HELP_PARTIALKEY = &H105&
HELP_QUIT = &H2 ' Terminate help
HELP_SETCONTENTS = &H5&
HELP_SETINDEX = &H5 ' Set current Index for multi index help
HELP_SETWINPOS = &H203&
HELP_FINDER = &HB ' Win95 version of HELP_CONTENTS
End Enum
Private Type HELPWININFO
wStructSize As Long
X As Long
Y As Long
dx As Long
dy As Long
wMax As Long
rgchMember As String * 2
End Type
Public Enum EShowHelpWindowPos
SW_HIDE = 0
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
SW_SHOW = 5
SW_SHOWMAXIMIZED = 3
SW_SHOWMINIMIZED = 2
SW_SHOWMINNOACTIVE = 7
SW_SHOWNA = 8
SW_SHOWNOACTIVATE = 4
SW_SHOWNORMAL = 1
End Enum
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect _
Lib "user32" (ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Declare Function MoveWindow _
Lib "user32" (ByVal hWnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Function ClientToScreen _
Lib "user32" (ByVal hWnd As Long, _
lpPoint As POINTAPI) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private m_bFileDialog As Boolean
' For template support
Private Declare Function LoadLibrary _
Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private m_lhInstance As Long
Private m_lTemplateName As Long
Private m_bMakeTBarFlat As Boolean
Public Event InitDialog(ByVal hDlg As Long)
Public Event FileChange(ByVal hDlg As Long)
Public Event FolderChange(ByVal hDlg As Long)
Public Event DialogOK(ByRef bCancel As Boolean)
Public Event TypeChange(ByVal hDlg As Long)
Public Event DialogClose()
Public Event WMCommand(ByVal hDlg As Long, wParam As Long, lParam As Long)
Public Sub WMCommand(ByVal hDlg As Long, wParam As Long, lParam As Long)
RaiseEvent WMCommand(hDlg, wParam, lParam)
End Sub
--------------------编程问答-------------------- Public Sub ParseMultiFileName(ByRef sDir As String, _
ByRef sFiles() As String, _
ByRef iFileCount As Long)
Dim iPos As Long
Dim iNextPos As Long
Dim sAllFiles As String
Dim i As Long
iPos = InStr(m_sFileName, vbNullChar & vbNullChar)
If iPos <> 0 Then
' multi names
sAllFiles = Left$(m_sFileName, iPos - 1)
iPos = 1
iNextPos = InStr(sAllFiles, vbNullChar)
Do While iNextPos <> 0
If (sDir = "") Then
sDir = Mid$(sAllFiles, iPos, iNextPos - iPos)
Else
iFileCount = iFileCount + 1
ReDim Preserve sFiles(1 To iFileCount) As String
sFiles(iFileCount) = Mid$(sAllFiles, iPos, iNextPos - iPos)
End If
iPos = iNextPos + 1
iNextPos = InStr(iPos, sAllFiles, vbNullChar)
Loop
iFileCount = iFileCount + 1
ReDim Preserve sFiles(1 To iFileCount) As String
sFiles(iFileCount) = Mid$(sAllFiles, iPos)
Else
' single file
iFileCount = 1
ReDim sFiles(1 To 1) As String
For i = Len(m_sFileName) To 1 Step -1
If Mid$(m_sFileName, i, 1) = "\" Then
If (i > 1) Then
sDir = Left$(m_sFileName, i - 1)
sFiles(1) = Mid$(m_sFileName, i + 1)
Else
sDir = ""
sFiles(1) = m_sFileName
End If
Exit Sub
End If
Next i
sDir = ""
sFiles(1) = m_sFileName
End If
End Sub
Public Sub DialogClose()
RaiseEvent DialogClose
End Sub
Public Function TypeChange(ByVal hDlg As Long) As Long
RaiseEvent TypeChange(hDlg)
End Function
Public Function InitDialog(ByVal hDlg As Long) As Long
RaiseEvent InitDialog(hDlg)
End Function
Public Function FileChange(ByVal hDlg As Long) As Long
RaiseEvent FileChange(hDlg)
End Function
Public Function FolderChange(ByVal hDlg As Long) As Long
RaiseEvent FolderChange(hDlg)
End Function
Public Function ConfirmOK() As Boolean
Dim bCancel As Boolean
bCancel = False
RaiseEvent DialogOK(bCancel)
If (bCancel) Then
ConfirmOK = False
Else
ConfirmOK = True
End If
End Function
Public Sub CentreDialog(ByVal hDlg As Long, ByRef oCentreTo As Object)
Dim lHwnd As Long
Dim tWR As RECT, tDR As RECT
Dim tp As POINTAPI
Dim lHwndCentreTo As Long
Dim lL As Long
Dim lT As Long
Dim lR As Long
' If we're showing a file dialog, then the rectangle is the
' parent of the dialog itself:
If (m_bFileDialog) Then
lHwnd = GetParent(hDlg)
Else
lHwnd = hDlg
End If
GetWindowRect lHwnd, tDR
On Error Resume Next
lHwndCentreTo = oCentreTo.hWnd
If (Err.Number = 0) Then
GetWindowRect lHwndCentreTo, tWR
Else
' Assume the screen object:
lR = SystemParametersInfo(SPI_GETWORKAREA, 0, tWR, 0)
If (lR = 0) Then
' Call failed - just use standard screen:
tWR.Left = 0
tWR.Top = 0
tWR.Right = Screen.Width \ Screen.TwipsPerPixelX
tWR.Bottom = Screen.Height \ Screen.TwipsPerPixelY
End If
End If
On Error GoTo 0
If (tWR.Right > 0) And (tWR.Bottom > 0) Then
lL = tWR.Left + (((tWR.Right - tWR.Left) - (tDR.Right - tDR.Left)) \ 2)
lT = tWR.Top + (((tWR.Bottom - tWR.Top) - (tDR.Bottom - tDR.Top)) \ 2)
MoveWindow lHwnd, lL, lT, (tDR.Right - tDR.Left), (tDR.Bottom - tDR.Top), 1
End If
End Sub
Public Sub GetDialogSize(ByVal hDlg As Long, _
ByRef lL As Long, _
ByRef lT As Long, _
ByRef lW As Long, _
ByRef lH As Long)
Dim lHwnd As Long
Dim tDR As RECT
If (m_bFileDialog) Then
lHwnd = GetParent(hDlg)
Else
lHwnd = hDlg
End If
GetWindowRect lHwnd, tDR
lL = tDR.Left
lT = tDR.Top
lW = tDR.Right - tDR.Left
lH = tDR.Bottom - tDR.Top
End Sub
Public Sub SetHelpPosition(X As Long, _
Y As Long, _
dx As Long, _
dy As Long, _
eWindowType As EShowHelpWindowPos)
Dim tW As HELPWININFO
Dim lPtr As Long
With tW
.X = X
.Y = Y
.dx = dx
.dy = dy
.wMax = eWindowType
.wStructSize = Len(tW)
End With
Dim cM As New cMemory
cM.AllocateMemory tW.wStructSize
lPtr = cM.Pointer
CopyMemory ByVal lPtr, tW, tW.wStructSize
WinHelp m_lhWnd, m_sHelpFile, HELP_SETWINPOS, lPtr
cM.FreeMemory
End Sub
Public Property Get CancelError() As Boolean
CancelError = m_bCancelError
End Property
Public Property Let CancelError(ByVal bCancelError As Boolean)
m_bCancelError = bCancelError
End Property
Public Property Get FileName() As String
'return object's FileName property
FileName = m_sFileName
End Property
Public Property Let FileName(ByVal sFileName As String)
'assign object's FileName property
m_sFileName = sFileName
End Property
Public Property Get Filter() As String
'return object's Filter property
Filter = m_sFilter
End Property
Public Property Let Filter(ByVal sFilter As String)
'assign object's Filter property
m_sFilter = sFilter
End Property
Public Property Get FilterIndex() As Long
'return object's FilterIndex property
FilterIndex = m_lFilterIndex
End Property
Public Property Let FilterIndex(ByVal lFilterIndex As Long)
'assign object's FilterIndex property
m_lFilterIndex = lFilterIndex
End Property
Public Property Get Color() As OLE_COLOR
'return object's Color property
Color = m_oColor
End Property
Public Property Let Color(ByVal oColor As OLE_COLOR)
'assign object's Color property
m_oColor = oColor
End Property
Public Property Get Copies() As Long
'return object's Copies property
Copies = m_lCopies
End Property
Public Property Let Copies(ByVal vNewValue As Long)
'assign object's Copies property
m_lCopies = vNewValue
End Property
Public Property Get DefaultExt() As String
'return object's DefaultExt property
DefaultExt = m_sDefaultExt
End Property
Public Property Let DefaultExt(ByVal vNewValue As String)
'assign object's DefaultExt property
m_sDefaultExt = vNewValue
End Property
Public Property Get DialogTitle() As String
'return object's FileName property
DialogTitle = m_sDialogTitle
End Property
Public Property Let DialogTitle(ByVal vNewValue As String)
'assign object's DialogTitle property
m_sDialogTitle = vNewValue
End Property
Public Property Get Flags() As Long
'return object's Flags property
Flags = m_lFlags
End Property
Public Property Let Flags(ByVal vNewValue As Long)
'assign object's Flags property
m_lFlags = vNewValue
End Property
Public Property Get FontBold() As Boolean
'return object's FontBold property
FontBold = m_Font.Bold
End Property
Public Property Let FontBold(ByVal vNewValue As Boolean)
'Assign object's FontBold property
m_Font.Bold = vNewValue
End Property
Public Property Get FontItalic() As Boolean
'Return object's FontItalic property
FontItalic = m_Font.Italic
End Property
Public Property Let FontItalic(ByVal vNewValue As Boolean)
'Assign object's FontItalic property
m_Font.Italic = vNewValue
End Property
Public Property Get FontName() As String
'Return object's Fontname property
FontName = m_Font.Name
End Property
Public Property Let FontName(ByVal vNewValue As String)
'Assign object's FontName property
m_Font.Name = vNewValue
End Property
Public Property Get FontSize() As Long
'Return object's FontSize property
FontSize = m_Font.Size
End Property
Public Property Let FontSize(ByVal vNewValue As Long)
'Assign object's FontSize property
m_Font.Size = vNewValue
End Property
Public Property Get FontStrikethru() As Boolean
'Return object's FontStrikethru property
FontStrikethru = m_Font.Strikethrough
End Property
Public Property Let FontStrikethru(ByVal vNewValue As Boolean)
'Assign object's - property
m_Font.Strikethrough = vNewValue
End Property
Public Property Get FontUnderline() As Boolean
'Return object's FontUnderline property
FontUnderline = m_Font.Underline
End Property
Public Property Let FontUnderline(ByVal vNewValue As Boolean)
'Assign object's FontUnderline property
m_Font.Underline = vNewValue
End Property
Public Property Get Font() As StdFont
Set Font = m_Font
End Property
Public Property Let Font(sFont As StdFont)
Set m_Font = sFont
End Property
Public Property Get FontColor() As OLE_COLOR
FontColor = m_oFontColor
End Property
Public Property Let FontColor(oColor As OLE_COLOR)
m_oFontColor = oColor
End Property
Public Property Get FromPage() As Long
'Return object's FromPAge property
FromPage = m_lFromPage
End Property
Public Property Let FromPage(ByVal vNewValue As Long)
'Assign object's FromPage property
m_lFromPage = vNewValue
End Property
--------------------编程问答-------------------- Public Property Get hWnd() As Long
'Return object's hWnd property
hWnd = m_lhWnd
End Property
Public Property Let hWnd(ByVal vNewValue As Long)
'Assign object's hWnd property
m_lhWnd = vNewValue
End Property
Public Property Get HelpCommand() As EShowHelpCommands
'Return object's HelpCommand property
HelpCommand = m_eHelpCommand
End Property
Public Property Let HelpCommand(ByVal vNewValue As EShowHelpCommands)
'Assign object's HelpCommand property
m_eHelpCommand = vNewValue
End Property
Public Property Get HelpContext() As String
'Return object's HelpContext property
HelpContext = m_sHelpContext
End Property
Public Property Let HelpContext(ByVal vNewValue As String)
'Assign object's HelpContext property
m_sHelpContext = vNewValue
End Property
Public Property Get HelpFile() As String
'Return object's HelpFile property
HelpFile = m_sHelpFile
End Property
Public Property Let HelpFile(ByVal vNewValue As String)
'Assign object's HelpFile property
m_sHelpFile = vNewValue
End Property
Public Property Get HelpKey() As String
'Return object's HelpKey property
HelpKey = m_sHelpKey
End Property
Public Property Let HelpKey(ByVal vNewValue As String)
'Assign object's HelpKey property
m_sHelpKey = vNewValue
End Property
Public Property Get InitDir() As String
'Return object's InitDir property
InitDir = m_sInitDir
End Property
Public Property Let InitDir(ByVal vNewValue As String)
'Assign object's InitDir property
m_sInitDir = vNewValue
End Property
Public Property Get Max() As Long
'Return object's Max property
Max = m_lMax
End Property
Public Property Let Max(ByVal vNewValue As Long)
'Assign object's - property
m_lMax = vNewValue
End Property
Public Property Get MaxFileSize() As Long
'Return object's MaxFileSize property
MaxFileSize = m_lMaxFileSize
End Property
Public Property Let MaxFileSize(ByVal vNewValue As Long)
'Assign object's MaxFileSize property
m_lMaxFileSize = vNewValue
End Property
Public Property Get Min() As Long
'Return object's Min property
Min = m_lMin
End Property
Public Property Let Min(ByVal vNewValue As Long)
'Assign object's Min property
m_lMin = vNewValue
End Property
Public Property Get Object() As Object
'Return object's Object property
Object = m_objObject
End Property
Public Property Let Object(ByVal vNewValue As Object)
'Assign object's Object property
Set m_objObject = vNewValue
End Property
Public Property Get PrinterDefault() As Integer
'Return object's PrinterDefault property
PrinterDefault = m_iPrinterDefault
End Property
Public Property Let PrinterDefault(ByVal vNewValue As Integer)
'Assign object's PrinterDefault property
m_iPrinterDefault = vNewValue
End Property
Public Property Get ToPage() As Long
'Return object's ToPage property
ToPage = m_lToPage
End Property
Public Property Let ToPage(ByVal vNewValue As Long)
'Assign object's ToPage property
m_lToPage = vNewValue
End Property
Public Property Get FileTitle() As String
'return object's FileTitle property
FileTitle = m_sFileTitle
End Property
Public Property Let FileTitle(ByVal vNewValue As String)
'assign object's FileTitle property
m_sFileTitle = vNewValue
End Property
Property Get CustomColor(ByVal i As Integer) As OLE_COLOR
CustomColor = mCommonDialog.CustomColor(i)
End Property
Property Let CustomColor(ByVal i As Integer, oValue As OLE_COLOR)
mCommonDialog.CustomColor(i) = oValue
End Property
Public Sub ShowOpen()
Dim bFileMustExist As Boolean
Dim bMultiSelect As Boolean
Dim bReadOnly As Boolean
Dim bHideReadOnly As Boolean
m_bFileDialog = True
bFileMustExist = FlagSet(m_lFlags, OFN_FILEMUSTEXIST)
bMultiSelect = FlagSet(m_lFlags, OFN_ALLOWMULTISELECT)
bReadOnly = FlagSet(m_lFlags, OFN_READONLY)
bHideReadOnly = FlagSet(m_lFlags, OFN_HIDEREADONLY)
If FlagSet(m_lFlags, OFN_ENABLETEMPLATE) Then
If m_lhInstance < 1 Then
m_lFlags = m_lFlags Xor OFN_ENABLETEMPLATE
End If
End If
If (m_lFilterIndex = 0) Then m_lFilterIndex = 1
If Not (mCommonDialog.VBGetOpenFileName2(m_sFileName, m_sFileTitle, bFileMustExist, bMultiSelect, bReadOnly, bHideReadOnly, m_sFilter, m_lFilterIndex, m_sInitDir, m_sDialogTitle, m_sDefaultExt, m_lhWnd, m_lFlags, m_bHookDialog, m_lhInstance, m_lTemplateName, Me)) Then
pCommonDialogError
End If
End Sub
Public Sub ShowSave()
Dim bOverWritePrompt As Boolean
m_bFileDialog = True
bOverWritePrompt = FlagSet(m_lFlags, OFN_OVERWRITEPROMPT)
If FlagSet(m_lFlags, OFN_ENABLETEMPLATE) Then
If m_lhInstance < 1 Then
m_lFlags = m_lFlags Xor OFN_ENABLETEMPLATE
End If
End If
If Not (mCommonDialog.VBGetSaveFileName2(m_sFileName, m_sFileTitle, bOverWritePrompt, m_sFilter, m_lFilterIndex, m_sInitDir, m_sDialogTitle, m_sDefaultExt, m_lhWnd, m_lFlags, m_bHookDialog, m_lhInstance, m_lTemplateName, Me)) Then
pCommonDialogError
End If
End Sub
Public Sub ShowColor()
Dim bAnyColor As Boolean
Dim bFullOpen As Boolean
Dim bDisableFullOpen As Boolean
Dim lColor As Long
m_bFileDialog = False
lColor = TranslateColor(m_oColor)
bAnyColor = FlagSet(m_lFlags, CC_AnyColor)
bFullOpen = FlagSet(m_lFlags, CC_FullOpen)
bDisableFullOpen = FlagSet(m_lFlags, CC_PreventFullOpen)
On Error GoTo ErrHandler
If Not (mCommonDialog.VBChooseColor(lColor, bAnyColor, bFullOpen, bDisableFullOpen, m_lhWnd, m_lFlags, m_bHookDialog, Me)) Then
' pCommonDialogError
Else
m_oColor = lColor
End If
ErrHandler:
' 用户按了“取消”按钮
End Sub
Public Sub ShowFont()
m_bFileDialog = False
If Not (mCommonDialog.VBChooseFont(m_Font, -1, m_lhWnd, m_oFontColor, m_lMin, m_lMax, m_lFlags, m_bHookDialog, Me)) Then
pCommonDialogError
End If
End Sub
Public Sub ShowPrinter()
Dim bDisablePageNumbers As Boolean
Dim bShowPrintToFile As Boolean
Dim bPrintToFile As Boolean
Dim bDisablePrintToFile As Boolean
Dim bCollate As Boolean
Dim bPreventWarning As Boolean
Dim bDisableSelection As Boolean
Dim ePR As EPrintRange
Dim iCopies As Integer
m_bFileDialog = False
iCopies = m_lCopies
bDisablePageNumbers = Not (FlagSet(m_lFlags, PD_PAGENUMS))
bDisableSelection = FlagSet(m_lFlags, PD_NOSELECTION)
bShowPrintToFile = Not (FlagSet(m_lFlags, PD_HIDEPRINTTOFILE))
bDisablePrintToFile = FlagSet(m_lFlags, PD_DISABLEPRINTTOFILE)
bPrintToFile = FlagSet(m_lFlags, PD_PRINTTOFILE)
bCollate = FlagSet(m_lFlags, PD_COLLATE)
bPreventWarning = FlagSet(m_lFlags, PD_NOWARNING)
If (mCommonDialog.VBPrintDlg(m_hDC, ePR, bDisablePageNumbers, m_lFromPage, m_lToPage, bDisableSelection, iCopies, bShowPrintToFile, bDisablePrintToFile, bPrintToFile, bCollate, bPreventWarning, m_lhWnd, m_objObject, m_lFlags, m_bHookDialog, Me)) Then
' Success
m_lCopies = iCopies
End If
End Sub
--------------------编程问答-------------------- '添加 Command1
Option Explicit
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Dim CbmCDlg As OPENFILENAME, sFile$
Private Sub Command1_Click()
sFile = ShowSave
If sFile <> "" Then
Open sFile For Output As #1
Print #1, "123456789"
Close #1
MsgBox "保存完成"
End If
End Sub
Private Function ShowSave() As String
CbmCDlg.lStructSize = Len(CbmCDlg)
CbmCDlg.hwndOwner = Me.hwnd
CbmCDlg.hInstance = App.hInstance
CbmCDlg.lpstrFilter = "记事本文件(*.txt) |*.txt"
CbmCDlg.lpstrFile = Space$(254)
CbmCDlg.nMaxFile = 255
CbmCDlg.lpstrFileTitle = Space$(254)
CbmCDlg.nMaxFileTitle = 255
CbmCDlg.lpstrInitialDir = "C:\"
CbmCDlg.lpstrTitle = "文件的保存"
ShowSave = IIf(GetSaveFileName(CbmCDlg), Trim$(CbmCDlg.lpstrFile), "")
End Function
--------------------编程问答--------------------
--------------------编程问答--------------------
vba自己有比如application.getopenfilename/application.getsavefilename
sF$=application.getopenfilename
会弹出"打开文件" 如果按了”取消“， 会返回False,否则返回文件的全路径
试一下吧 --------------------编程问答-------------------- 不对，显示“编辑错误，在end sub ,end function,end 属性后面只能出现注释”
且错误行是
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
--------------------编程问答-------------------- VBA自己有现实那些对话框的方法 --------------------编程问答-------------------- --------------------编程问答--------------------
请问在哪里？ --------------------编程问答-------------------- 7F 检查一下你粘贴后的内容吧 --------------------编程问答-------------------- 6楼..................................... --------------------编程问答-------------------- cbm666老师，你这个好象在vba里不能用，只能在VB里用，我在autocad vba 中用时出错
autocad vba 运行到
CbmCDlg.hwndOwner = Me.hwnd 时说没有.hwnd属性，可能在VB里可以
--------------------编程问答--------------------
--------------------编程问答--------------------
'vba 不用引用任何东西打开对话框
dlgAnswer = Application.Dialogs(xlDialogOpen).Show
dlgAnswer=? --------------------编程问答-------------------- 不会吧,VBA中哪有application.getopenfilename这种东西
至于Application.Dialogs(xlDialogOpen).Show这种东西,那也是调用的宿主程序中标准的打开文档的对话框吧,那个确定后是会自动打开一个文档的,这和楼主的需求其实并非一回事吧 --------------------编程问答--------------------
你试过了么?没试你怎么知道没有?
补充：VB , 基础类
