Thema: ComDlg-Dialog aufrufen

StandardModule: Modul1

Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
   Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

Sub CallOpenDialog()
   Dim OpenFile As OPENFILENAME
   Dim lReturn As Long
   Dim sFilter As String
   OpenFile.lStructSize = Len(OpenFile)
   sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
   With OpenFile
      .lpstrFilter = sFilter
      .nFilterIndex = 1
      .lpstrFile = String(257, 0)
      .nMaxFile = Len(OpenFile.lpstrFile) - 1
      .lpstrFileTitle = OpenFile.lpstrFile
      .nMaxFileTitle = OpenFile.nMaxFile
      .lpstrInitialDir = Application.DefaultFilePath
      .lpstrTitle = "ComDlg API statt OCX nutzen"
      .flags = 0
   End With
   lReturn = GetOpenFileName(OpenFile)
   If lReturn = 0 Then
      MsgBox "Suche abgebrochen!", vbInformation
   Else
      MsgBox Trim(Left(OpenFile.lpstrFile, _
         InStr(1, OpenFile.lpstrFile, Chr(0)) - 1))
   End If
End Sub

Sub CopyText()
   Dim ClipAbLage As DataObject
   Dim iRow As Integer
   Dim sTxt As String
   Set ClipAbLage = New DataObject
   iRow = ActiveCell.Row
   Do Until IsEmpty(Cells(iRow, ActiveCell.Column))
      sTxt = sTxt & " " & Cells(iRow, ActiveCell.Column).Value
      iRow = iRow + 1
   Loop
   sTxt = Right(sTxt, Len(sTxt) - 1)
   ClipAbLage.SetText sTxt
   ClipAbLage.PutInClipboard
End Sub

Beiträge aus dem Excel-Forum zu den Themen API und Dialog