MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


2 participantes

    [Resolvido]Personalizar Caixa de Diálogo do Windows

    kleber.arruda
    kleber.arruda
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 56
    Registrado : 22/09/2016

    [Resolvido]Personalizar Caixa de Diálogo do Windows Empty [Resolvido]Personalizar Caixa de Diálogo do Windows

    Mensagem  kleber.arruda 10/2/2017, 14:49

    Bom dia Galera!!!

    Estreiando aqui no Maximo Access, pois realmente não encontrei nenhum solução!

    Atualmente uso o seguinte código para disponibilizar ao usuário visualizar os arquivos de um determinado diretório:

    Código:

    Public blnSair As Boolean

    Type tagOPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        strFilter As String
        strCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        strFile As String
        nMaxFile As Long
        strFileTitle As String
        nMaxFileTitle As Long
        strInitialDir As String
        strTitle As String
        Flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        strDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
       
    End Type

    Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
        Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

    Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
        Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean

    Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

    Global Const ahtOFN_READONLY = &H1

    Global Const ahtOFN_OVERWRITEPROMPT = &H2

    Global Const ahtOFN_HIDEREADONLY = &H4

    Global Const ahtOFN_NOCHANGEDIR = &H8

    Global Const ahtOFN_SHOWHELP = &H10

    Global Const ahtOFN_NOVALIDATE = &H100

    Global Const ahtOFN_ALLOWMULTISELECT = &H200

    Global Const ahtOFN_EXTENSIONDIFFERENT = &H400

    Global Const ahtOFN_PATHMUSTEXIST = &H800

    Global Const ahtOFN_FILEMUSTEXIST = &H1000

    Global Const ahtOFN_CREATEPROMPT = &H2000

    Global Const ahtOFN_SHAREAWARE = &H4000

    Global Const ahtOFN_NOREADONLYRETURN = &H8000

    Global Const ahtOFN_NOTESTFILECREATE = &H10000

    Global Const ahtOFN_NONETWORKBUTTON = &H20000

    Global Const ahtOFN_NOLONGNAMES = &H40000

    Global Const ahtOFN_EXPLORER = &H80000

    Global Const ahtOFN_NODEREFERENCELINKS = &H100000

    Global Const ahtOFN_LONGNAMES = &H200000

    Function getOpenFile(Optional varDirectory As Variant, _
        Optional varTitleForDialog As Variant) As Variant

        Dim strFilter                              As String
        Dim lngFlags                                As Long
        Dim varFileName                            As Variant

        lngFlags = ahtOFN_FILEMUSTEXIST Or _
                    ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
                   
        If IsMissing(varDirectory) Then
       
            varDirectory = ""
                   
        End If
       
        If IsMissing(varTitleForDialog) Then
       
            varTitleForDialog = ""
           
        End If

        strFilter = ahtAddFilterItem(strFilter, _
                    "Arquivos Microsoft Excel (*.XLS)", "*.csv")

        varFileName = ahtCommonFileOpenSave( _
                        OpenFile:=True, _
                        InitialDir:=varDirectory, _
                        Filter:=strFilter, _
                        Flags:=lngFlags, _
                        DialogTitle:=varTitleForDialog)

        If Not IsNull(varFileName) Then
       
            varFileName = TrimNull(varFileName)
           
        End If
       
        getOpenFile = varFileName
       
    End Function

    Function ahtCommonFileOpenSave( _
                Optional ByRef Flags As Variant, _
                Optional ByVal InitialDir As Variant, _
                Optional ByVal Filter As Variant, _
                Optional ByVal FilterIndex As Variant, _
                Optional ByVal DefaultExt As Variant, _
                Optional ByVal Filename As Variant, _
                Optional ByVal DialogTitle As Variant, _
                Optional ByVal hwnd As Variant, _
                Optional ByVal OpenFile As Variant) As Variant

        Dim OFN                                As tagOPENFILENAME
        Dim strFileName                        As String
        Dim strFileTitle                        As String
        Dim fResult                            As Boolean

        If IsMissing(InitialDir) Then InitialDir = CurDir
        If IsMissing(Filter) Then Filter = ""
        If IsMissing(FilterIndex) Then FilterIndex = 1
        If IsMissing(Flags) Then Flags = 0&
        If IsMissing(DefaultExt) Then DefaultExt = "txt"
        If IsMissing(Filename) Then Filename = ""
        If IsMissing(DialogTitle) Then DialogTitle = ""
        If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
        If IsMissing(OpenFile) Then OpenFile = True

        strFileName = Left(Filename & String(256, 0), 256)
        strFileTitle = String(256, 0)

        With OFN
            .lStructSize = Len(OFN)
            .hwndOwner = hwnd
            .strFilter = Filter
            .nFilterIndex = FilterIndex
            .strFile = strFileName
            .nMaxFile = Len(strFileName)
            .strFileTitle = strFileTitle
            .nMaxFileTitle = Len(strFileTitle)
            .strTitle = DialogTitle
            .Flags = Flags
            .strDefExt = DefaultExt
            .strInitialDir = InitialDir
            .hInstance = 0
            .strCustomFilter = ""
            .nMaxCustFilter = 0
            .lpfnHook = 0
            'New for NT 4.0
            .strCustomFilter = String(255, 0)
            .nMaxCustFilter = 255
        End With
       

        If OpenFile Then
       
            fResult = aht_apiGetOpenFileName(OFN)
           
        Else
       
            fResult = aht_apiGetSaveFileName(OFN)
           
        End If


        If fResult Then

            If Not IsMissing(Flags) Then
           
                Flags = OFN.Flags
                ahtCommonFileOpenSave = TrimNull(OFN.strFile)
               
            Else
                ahtCommonFileOpenSave = "" 'alterado por JR.
               
            End If
           
        End If
       
    End Function

    Function ahtAddFilterItem(strFilter As String, _
        strDescription As String, Optional VarItem As Variant) As String
       
        If IsMissing(VarItem) Then VarItem = "*.*"
        ahtAddFilterItem = strFilter & _
                    strDescription & vbNullChar & _
                    VarItem & vbNullChar
    End Function


    Private Function TrimNull(ByVal strItem As String) As String

        Dim intPos                              As Integer
       
        intPos = InStr(strItem, vbNullChar)
       
        If intPos > 0 Then
       
            TrimNull = Left(strItem, intPos - 1)
           
        Else
       
            TrimNull = strItem
           
        End If
       
    End Function

    Function AbreCaixaDialogo() As String

        Dim strFilter As String
       
        'para utilizar defina o filtro tipo de arquivo conforme abaixo
        '  TipoArquivo = "*_re.txt"
        '  strFilter = ahtAddFilterItem(strFilter, "Arquivos de Registro de Exportação (*_re.txt)", TipoArquivo)
        '  ou
       
        strFilter = ahtAddFilterItem(strFilter, "*.*")
       
        'Para Utilizar:
       
        AbreCaixaDialogo = ahtCommonFileOpenSave(, strCurDir, strFilter, , , _
                          NomeArquivo, "Selecione o arquivo desejado", , True)
       
    End Function

    Ocorre que, eu queria personalizar o campo que armazena as informações do diretório desta janela, não permitindo ao usuário, alterar o diretório, e ter acesso a outros arquivos.

    Desde já agradeço.
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7996
    Registrado : 15/03/2013

    [Resolvido]Personalizar Caixa de Diálogo do Windows Empty Re: [Resolvido]Personalizar Caixa de Diálogo do Windows

    Mensagem  Alvaro Teixeira 10/2/2017, 18:32

    Olá Kleber, bem vindo ao fórum.
    Se pretende limitar, o ideal será lançar os nomes dos ficheiros, numa caixa de listagem.
    Estou no celular.
    Experimente uma busca aqui no fórum, não deve faltar exemplos.
    Veja como fazer:
    https://www.maximoaccess.com/t1115-busca-no-forum-search

    Qualquer coisa estamos ca.
    Abraço
    kleber.arruda
    kleber.arruda
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 56
    Registrado : 22/09/2016

    [Resolvido]Personalizar Caixa de Diálogo do Windows Empty Re: [Resolvido]Personalizar Caixa de Diálogo do Windows

    Mensagem  kleber.arruda 10/2/2017, 18:46

    ahteixeira Muito Obrigado pelo retorno!

    Estou fazendo exatamente isso!

    Muito Obrigado
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7996
    Registrado : 15/03/2013

    [Resolvido]Personalizar Caixa de Diálogo do Windows Empty Re: [Resolvido]Personalizar Caixa de Diálogo do Windows

    Mensagem  Alvaro Teixeira 10/2/2017, 21:00

    Olá, ficamos aguardar.
    Qualquer coisa estamos cá.
    Já vi por aqui codigos mais simples.
    Abraço
    kleber.arruda
    kleber.arruda
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 56
    Registrado : 22/09/2016

    [Resolvido]Personalizar Caixa de Diálogo do Windows Empty Personalizar Caixa de Diálogo do Windows

    Mensagem  kleber.arruda 3/10/2017, 13:44

    Resolvido !
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7996
    Registrado : 15/03/2013

    [Resolvido]Personalizar Caixa de Diálogo do Windows Empty Re: [Resolvido]Personalizar Caixa de Diálogo do Windows

    Mensagem  Alvaro Teixeira 3/10/2017, 16:59

    Olá Kleber Arruda,
    Obrigado pelo retorno, o fórum agradece.
    Abraço

    Conteúdo patrocinado


    [Resolvido]Personalizar Caixa de Diálogo do Windows Empty Re: [Resolvido]Personalizar Caixa de Diálogo do Windows

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 21/11/2024, 23:43