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


5 participantes

    [Resolvido]clsCommonDialog não funfa no Windows 7

    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 26/3/2015, 13:10

    Olá Feras de plantão, bom dia.

    Sei que a "coisa" é medonha mas só para não perder o rebolado...

    Possuo um código que funciona perfeitamente no Windows XP, contudo, no Windows 7 ocorre um problema que não pude contornar.

    Trata-se da clsCommonDialog e o código é este:

    Option Compare Database


    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    ' VERSION 1.0 CLASS
    ' BEGIN
    '   MultiUse = -1  'True
    '   Persistable = 0  'NotPersistable
    '   DataBindingBehavior = 0  'vbNone
    '   DataSourceBehavior = 0   'vbNone
    '   MTSTransactionMode = 0   'NotAnMTSObject
    ' End
    ' Attribute VB_Name = "clsCommonDialog"
    ' Attribute VB_GlobalNameSpace = False
    ' Attribute VB_Creatable = True
    ' Attribute VB_PredeclaredId = False
    ' Attribute VB_Exposed = True
    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 

    Option Explicit
    ' This code is from the Microsoft Knowledge Base.


    'API function called by ChooseColor method
    Private Declare Function ChooseColor Lib "Comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long

    'API function called by ShowOpen method
    Private Declare Function GetOpenFileName Lib "Comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

    'API function called by ShowSave method
    Private Declare Function GetSaveFileName Lib "Comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

    'API function to retrieve extended error information
    Private Declare Function Comdlg32ExtendedError Lib "Comdlg32.dll" () As Long

    'API memory functions
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
            hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)


    'constants for API memory functions
    Private Const GMEM_MOVEABLE = &H2
    Private Const GMEM_ZEROINIT = &H40
    Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)


    'data buffer for the ChooseColor function
    Private Type ChooseColor
           lStructSize As Long
           hwndOwner As Long
           hInstance As Long
           rgblRetult As Long
           lpCustColors As Long
           Flags As Long
           lCustData As Long
           lpfnHook As Long
           lpTemplateName As String
    End Type

    'data buffer for the GetOpenFileName and GetSaveFileName functions
    Private Type OPENFILENAME
           lStructSize As Long
           hwndOwner As Long
           hInstance As Long
           lpstrFilter As String
           lpstrCustomFilter As String
           nMaxCustFilter As Long
           iFilterIndex 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


    'internal property buffers

    Private iAction As Integer         'internal buffer for Action property
    Private bCancelError As Boolean    'internal buffer for CancelError property
    Private lColor As Long             'internal buffer for Color property
    Private lCopies As Long            'internal buffer for lCopies property
    Private sDefaultExt As String      'internal buffer for sDefaultExt property
    Private sDialogTitle As String     'internal buffer for DialogTitle property
    Private sFileName As String        'internal buffer for FileName property
    Private sFileTitle As String       'internal buffer for FileTitle property
    Private sFilter As String          'internal buffer for Filter property
    Private iFilterIndex As Integer    'internal buffer for FilterIndex property
    Private lFlags As Long             'internal buffer for Flags property
    Private lHDC As Long               'internal buffer for hdc property
    Private sInitDir As String         'internal buffer for InitDir property
    Private lMax As Long               'internal buffer for Max property
    Private lMaxFileSize As Long       'internal buffer for MaxFileSize property
    Private lMin As Long               'internal buffer for Min property
    Private objObject As Object        'internal buffer for Object property

    Private lApiReturn As Long          'internal buffer for APIReturn property
    Private lExtendedError As Long      'internal buffer for ExtendedError property



    'constants for color dialog

    Private Const CDERR_DIALOGFAILURE = &HFFFF
    Private Const CDERR_FINDRESFAILURE = &H6
    Private Const CDERR_GENERALCODES = &H0
    Private Const CDERR_INITIALIZATION = &H2
    Private Const CDERR_LOADRESFAILURE = &H7
    Private Const CDERR_LOADSTRFAILURE = &H5
    Private Const CDERR_LOCKRESFAILURE = &H8
    Private Const CDERR_MEMALLOCFAILURE = &H9
    Private Const CDERR_MEMLOCKFAILURE = &HA
    Private Const CDERR_NOHINSTANCE = &H4
    Private Const CDERR_NOHOOK = &HB
    Private Const CDERR_NOTEMPLATE = &H3
    Private Const CDERR_REGISTERMSGFAIL = &HC
    Private Const CDERR_STRUCTSIZE = &H1


    'constants for file dialog

    Private Const FNERR_BUFFERTOOSMALL = &H3003
    Private Const FNERR_FILENAMECODES = &H3000
    Private Const FNERR_INVALIDFILENAME = &H3002
    Private Const FNERR_SUBCLASSFAILURE = &H3001

    Private Type BROWSEINFO
     hOwner As Long
     pidlRoot As Long
     pszDisplayName As String
     lpszTitle As String
     ulFlags As Long
     lpfn As Long
     lParam As Long
     iImage As Long
    End Type

    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
               "SHGetPathFromIDListA" (ByVal pidl As Long, _
               ByVal pszPath As String) As Long
               
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
               "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
               As Long
               
    Private Const BIF_RETURNONLYFSDIRS = &H1

    Public Property Get Filter() As String
       'return object's Filter property
       Filter = sFilter
    End Property

    Public Sub ShowColor()
       'display the color dialog box
       
       Dim tChooseColor As ChooseColor
       Dim alCustomColors(15) As Long
       Dim lCustomColorSize As Long
       Dim lCustomColorAddress As Long
       Dim lMemHandle As Long
       
       Dim N As Integer
           
       On Error GoTo ShowColorError
       
       
       '***    init property buffers
       
       iAction = 3  'Action property - ShowColor
       lApiReturn = 0  'APIReturn property
       lExtendedError = 0  'ExtendedError property
       
       
       '***    prepare tChooseColor data
       
       'lStructSize As Long
       tChooseColor.lStructSize = Len(tChooseColor)
       
       'hwndOwner As Long
       tChooseColor.hwndOwner = 0& 'lhdc

       'hInstance As Long
       
       'rgblRetult As Long
       tChooseColor.rgblRetult = lColor
       
       'lpCustColors As Long
       ' Fill custom colors array with all white
       For N = 0 To UBound(alCustomColors)
           alCustomColors(N) = &HFFFFFF
       Next
       ' Get size of memory needed for custom colors
       lCustomColorSize = Len(alCustomColors(0)) * 16
       ' Get a global memory block to hold a copy of the custom colors
       lMemHandle = GlobalAlloc(GHND, lCustomColorSize)
       
       If lMemHandle = 0 Then
           Exit Sub
       End If
       ' Lock the custom color's global memory block
       lCustomColorAddress = GlobalLock(lMemHandle)
       If lCustomColorAddress = 0 Then
           Exit Sub
       End If
       ' Copy custom colors to the global memory block
       Call CopyMemory(ByVal lCustomColorAddress, alCustomColors(0), lCustomColorSize)

       tChooseColor.lpCustColors = lCustomColorAddress
       
       'flags As Long
       tChooseColor.Flags = lFlags
           
       'lCustData As Long
       'lpfnHook As Long
       'lpTemplateName As String
       
       
       '***    call the ChooseColor API function
       lApiReturn = ChooseColor(tChooseColor)
       
       
       '***    handle return from ChooseColor API function
       Select Case lApiReturn
           
           Case 0  'user canceled
           If bCancelError = True Then
               'generate an error
               On Error GoTo 0
               err.Raise Number:=vbObjectError + 894, _
                   Description:="Cancel Pressed"
               Exit Sub
           End If
           
           Case 1  'user selected a color
               'update property buffer
               lColor = tChooseColor.rgblRetult
           
           Case Else   'an error occured
               'call Comdlg32ExtendedError
               lExtendedError = Comdlg32ExtendedError
           
       End Select

    Exit Sub

    ShowColorError:
       Exit Sub
    End Sub

    Public Sub ShowOpen()
       'display the file open dialog box
       ShowFileDialog (1)  'Action property - ShowOpen
    End Sub

    Public Sub ShowSave()
       'display the file save dialog box
       ShowFileDialog (2)  'Action property - ShowSave
    End Sub

    Public Property Get Filename() As String
       'return object's FileName property
       Filename = sFileName
    End Property

    Public Property Let Filename(vNewValue As String)
       'assign object's FileName property
       sFileName = vNewValue
    End Property

    Public Property Let Filter(vNewValue As String)
       'assign object's Filter property
       sFilter = vNewValue
    End Property

    Private Function sLeftOfNull(ByVal sIn As String)
       'returns the part of sIn preceding Chr$(0)
       Dim lNullPos As Long
       
       'init output
       sLeftOfNull = sIn
       
       'get position of first Chr$(0) in sIn
       lNullPos = InStr(sIn, Chr$(0))
       
       'return part of sIn to left of first Chr$(0) if found
       If lNullPos > 0 Then
           sLeftOfNull = Mid$(sIn, 1, lNullPos - 1)
       End If
       
    End Function


    Public Property Get Action() As Integer
       'Return object's Action property
       Action = iAction
    End Property

    Private Function sAPIFilter(sIn)
       'prepares sIn for use as a filter string in API common dialog functions
       Dim lChrNdx As Long
       Dim sOneChr As String
       Dim sOutStr As String
       
       'convert any | characters to nulls
       For lChrNdx = 1 To Len(sIn)
           sOneChr = Mid$(sIn, lChrNdx, 1)
           If sOneChr = "|" Then
               sOutStr = sOutStr & Chr$(0)
           Else
               sOutStr = sOutStr & sOneChr
           End If
       Next
       
       'add a null to the end
       sOutStr = sOutStr & Chr$(0)
       
       'return sOutStr
       sAPIFilter = sOutStr
       
    End Function

    Public Property Get FilterIndex() As Integer
       'return object's FilterIndex property
       FilterIndex = iFilterIndex
    End Property

    Public Property Let FilterIndex(vNewValue As Integer)
       iFilterIndex = vNewValue
    End Property

    Public Property Get CancelError() As Boolean
       'Return object's CancelError property
       CancelError = bCancelError
    End Property

    Public Property Let CancelError(vNewValue As Boolean)
       'Assign object's CancelError property
       bCancelError = vNewValue
    End Property

    Public Property Get Color() As Long
       'return object's Color property
       Color = lColor
    End Property

    Public Property Let Color(vNewValue As Long)
       'assign object's Color property
       lColor = vNewValue
    End Property

    Public Property Get DefaultExt() As String
       'return object's DefaultExt property
       DefaultExt = sDefaultExt
    End Property

    Public Property Let DefaultExt(vNewValue As String)
       'assign object's DefaultExt property
       sDefaultExt = vNewValue
    End Property

    Public Property Get DialogTitle() As String
       'return object's FileName property
       DialogTitle = sDialogTitle
    End Property

    Public Property Let DialogTitle(vNewValue As String)
       'assign object's DialogTitle property
       sDialogTitle = vNewValue
    End Property

    Public Property Get Flags() As Long
       'return object's Flags property
       Flags = lFlags
    End Property

    Public Property Let Flags(vNewValue As Long)
       'assign object's Flags property
       lFlags = vNewValue
    End Property

    Public Property Get hdc() As Long
       'Return object's hDC property
       hdc = lHDC
    End Property

    Public Property Let hdc(vNewValue As Long)
       'Assign object's hDC property
       lHDC = vNewValue
    End Property

    Public Property Get InitDir() As String
       'Return object's InitDir property
       InitDir = sInitDir
    End Property

    Public Property Let InitDir(vNewValue As String)
       'Assign object's InitDir property
       sInitDir = vNewValue
    End Property

    Public Property Get Max() As Long
       'Return object's Max property
       Max = lMax
    End Property

    Public Property Let Max(vNewValue As Long)
       'Assign object's - property
       lMax = vNewValue
    End Property

    Public Property Get MaxFileSize() As Long
       'Return object's MaxFileSize property
       MaxFileSize = lMaxFileSize
    End Property

    Public Property Let MaxFileSize(vNewValue As Long)
       'Assign object's MaxFileSize property
       lMaxFileSize = vNewValue
    End Property

    Public Property Get Min() As Long
       'Return object's Min property
       Min = lMin
    End Property

    Public Property Let Min(vNewValue As Long)
       'Assign object's Min property
       lMin = vNewValue
    End Property

    Public Property Get Object() As Object
       'Return object's Object property
       Object = objObject
    End Property

    Public Property Let Object(vNewValue As Object)
       'Assign object's Object property
       objObject = vNewValue
    End Property

    Public Property Get FileTitle() As String
       'return object's FileTitle property
       FileTitle = sFileTitle
    End Property

    Public Property Let FileTitle(vNewValue As String)
       'assign object's FileTitle property
       sFileTitle = vNewValue
    End Property

    Public Property Get APIReturn() As Long
       'return object's APIReturn property
       APIReturn = lApiReturn
    End Property

    Public Property Get ExtendedError() As Long
       'return object's ExtendedError property
       ExtendedError = lExtendedError
    End Property


    Private Function sByteArrayToString(abBytes() As Byte) As String
       'return a string from a byte array
       Dim lBytePoint As Long
       Dim lByteVal As Long
       Dim sOut As String
       
       'init array pointer
       lBytePoint = LBound(abBytes)
       
       'fill sOut with characters in array
       While lBytePoint <= UBound(abBytes)
           
           lByteVal = abBytes(lBytePoint)
           
           'return sOut and stop if Chr$(0) is encountered
           If lByteVal = 0 Then
               sByteArrayToString = sOut
               Exit Function
           Else
               sOut = sOut & Chr$(lByteVal)
           End If
           
           lBytePoint = lBytePoint + 1
       
       Wend
       
       'return sOut if Chr$(0) wasn't encountered
       sByteArrayToString = sOut
       
    End Function
    Private Sub ShowFileDialog(ByVal iAction As Integer)
       
       'display the file dialog for ShowOpen or ShowSave
       
       Dim tOpenFile As OPENFILENAME
       Dim lMaxSize As Long
       Dim sFileNameBuff As String
       Dim sFileTitleBuff As String
       
       On Error GoTo ShowFileDialogError
       
       
       '***    init property buffers
       
       iAction = iAction  'Action property
       lApiReturn = 0  'APIReturn property
       lExtendedError = 0  'ExtendedError property
           
       
       '***    prepare tOpenFile data
       
       'tOpenFile.lStructSize As Long
       tOpenFile.lStructSize = Len(tOpenFile)
       
       'tOpenFile.hWndOwner As Long - init from hdc property
       tOpenFile.hwndOwner = Application.hWndAccessApp ' 0& ' Just use 0 !
       
       'tOpenFile.lpstrFilter As String - init from Filter property
       tOpenFile.lpstrFilter = sAPIFilter(sFilter)
           
       'tOpenFile.iFilterIndex As Long - init from FilterIndex property
       tOpenFile.iFilterIndex = iFilterIndex
       
       'tOpenFile.lpstrFile As String
           'determine size of buffer from MaxFileSize property
           If lMaxFileSize > 0 Then
               lMaxSize = lMaxFileSize
           Else
               lMaxSize = 256
           End If
       
       'tOpenFile.lpstrFile As Long - init from FileName property
           'prepare sFileNameBuff
           sFileNameBuff = sFileName
           'pad with spaces
           While Len(sFileNameBuff) < lMaxSize - 1
               sFileNameBuff = sFileNameBuff & " "
           Wend
           'trim to length of lMaxFileSize - 1
          sFileNameBuff = Mid$(sFileNameBuff, 1, lMaxFileSize - 1)
           'null terminate
           sFileNameBuff = sFileNameBuff & Chr$(0)
       tOpenFile.lpstrFile = sFileNameBuff
       
       'nMaxFile As Long - init from MaxFileSize property
       If lMaxFileSize <> 255 Then  'default is 255
           tOpenFile.nMaxFile = lMaxFileSize
       End If
               
       'lpstrFileTitle As String - init from FileTitle property
           'prepare sFileTitleBuff
           sFileTitleBuff = sFileTitle
           'pad with spaces
           While Len(sFileTitleBuff) < lMaxSize - 1
               sFileTitleBuff = sFileTitleBuff & " "
           Wend
           'trim to length of lMaxFileSize - 1
           sFileTitleBuff = Mid$(sFileTitleBuff, 1, lMaxFileSize - 1)
           'null terminate
           sFileTitleBuff = sFileTitleBuff & Chr$(0)
       tOpenFile.lpstrFileTitle = sFileTitleBuff
           
       'tOpenFile.lpstrInitialDir As String - init from InitDir property
       tOpenFile.lpstrInitialDir = sInitDir
       
       'tOpenFile.lpstrTitle As String - init from DialogTitle property
       tOpenFile.lpstrTitle = sDialogTitle
       
       'tOpenFile.flags As Long - init from Flags property
       tOpenFile.Flags = lFlags
           
       'tOpenFile.lpstrDefExt As String - init from DefaultExt property
       tOpenFile.lpstrDefExt = sDefaultExt
       
       
       '***    call the GetOpenFileName API function
       Select Case iAction
           Case 1  'ShowOpen
               lApiReturn = GetOpenFileName(tOpenFile)
           Case 2  'ShowSave
               lApiReturn = GetSaveFileName(tOpenFile)
           Case Else   'unknown action
               Exit Sub
       End Select
       
       
       '***    handle return from GetOpenFileName API function
       Select Case lApiReturn
           
           Case 0  'user canceled
           If bCancelError = True Then
               'generate an error
               err.Raise (2001)
               Exit Sub
           End If
           
           Case 1  'user selected or entered a file
               'sFileName gets part of tOpenFile.lpstrFile to the left of first Chr$(0)
               sFileName = sLeftOfNull(tOpenFile.lpstrFile)
               sFileTitle = sLeftOfNull(tOpenFile.lpstrFileTitle)
           
           Case Else   'an error occured
               'call Comdlg32ExtendedError
               lExtendedError = Comdlg32ExtendedError
           
       End Select
       

    Exit Sub

    ShowFileDialogError:
       
       Exit Sub

    End Sub




    Private Sub Class_Initialize()
    Me.hdc = 0
    Me.MaxFileSize = 256
    Me.Max = 256
    Me.FileTitle = vbNullString
    Me.DialogTitle = "Please Select a File"
    Me.InitDir = vbNullString
    Me.DefaultExt = vbNullString
    End Sub




    '************** Code Start **************
    'This code was originally written by Terry Kreft.
    'It is not to be altered or distributed,
    'except as part of an application.
    'You are free to use it in any application,
    'provided the copyright notice is left unchanged.
    '
    'Code courtesy of
    'Terry Kreft



    Public Function BrowseFolder(szDialogTitle As String) As String
     Dim X As Long, bi As BROWSEINFO, dwIList As Long
     Dim szPath As String, wpos As Integer
     
       With bi
           .hOwner = hWndAccessApp
           .lpszTitle = szDialogTitle
           .ulFlags = BIF_RETURNONLYFSDIRS
       End With
       
       dwIList = SHBrowseForFolder(bi)
       szPath = Space$(512)
       X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
       
       If X Then
           wpos = InStr(szPath, Chr(0))
           BrowseFolder = Left$(szPath, wpos - 1)
       Else
           BrowseFolder = ""
       End If
    End Function

    '*********** Code End *****************


    Observação: Eu já registrei a Ocx devidamente cmo nada o figurino, mas mesmo assim não funfa.

    Alguém teria alguma sugestão?

    Abraços, WSenna


    Última edição por wsenna em 1/4/2015, 18:55, editado 1 vez(es)
    formiga10x
    formiga10x
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 818
    Registrado : 11/09/2013

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  formiga10x 26/3/2015, 23:18

    Dê uma olhada neste tópico Wsenna.
    Já tive um problema parecido no Win7 e resolvi basicamente movendo a ocx para a pasta adequada e registrando a ocx pelo cmd com adm.

    Link


    .................................................................................
    Abraço
    Formiga10x

    Sempre que possível poste o bd ou parte dele, com uma explicação bem clara e objetiva do que quer.
    “Um homem não está acabado quando enfrenta a derrota. Ele está acabado quando desiste - Richard Nixon”
    Formiga10x

    "Lembro do exato momento em que me dei conta que boa parte de minha vida foi dedicada a localizar erros em meus próprios programas."
    - Maurice Vicent Wilkes
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 27/3/2015, 05:08

    Olá Formiga, bom dia.

    Amigão, no meu caso a Ocx já está na pasta C:\Windows\System32 e registrada mas mesmo assim a coisa não funfa.

    Abraços, WSenna
    Avelino Sampaio
    Avelino Sampaio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3877
    Registrado : 04/04/2010

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  Avelino Sampaio 27/3/2015, 08:44

    Mas e a versão do Access, continua com a 2003 ?

    Aguardamos


    Última edição por Avelino Sampaio em 27/3/2015, 17:41, editado 1 vez(es)


    .................................................................................
    Vídeos, livros, kit MontaRibbons e acesso irrestrito ao site UsandoAcces  
    Clique AQUI e analise o custo beneficio do material oferecido.
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 27/3/2015, 10:25

    Olá Avelino, bom dia.

    Isso mesmo, o problema é que na universidade todas as máquinas ainda rodam o 2003, daí...

    Abraços, WSenna
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11016
    Registrado : 04/11/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  JPaulo 27/3/2015, 17:08

    Ola;

    Não sei se é a mesma coisa, mas este funciona no Windows 7 com Ms Access 2003;

    http://access.mvps.org/access/api/api0002.htm

    Você quer utilizar o FileDialog para que fim ?
    Somente para eu entender...


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]clsCommonDialog não funfa no Windows 7 Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]clsCommonDialog não funfa no Windows 7 Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]clsCommonDialog não funfa no Windows 7 Folder_announce_new Instruções SQL como utilizar...
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 27/3/2015, 23:13

    Olá Feras de plantão, boa noite.

    Grande JPaulo, meu Guru de longa data, experimentei vosso código mas não funfou como deveria.


    Abraços, WSenna


    Última edição por wsenna em 3/4/2015, 05:11, editado 2 vez(es)
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  Alvaro Teixeira 28/3/2015, 00:27

    Olá Wsenna, experimente o teste abaixo:

    OpenFileNameTeste.rar

    O OpenDialog funciona, está a dar erro é na linha:

           'load file for preview
           TiffViewer1.LoadImage (Text1.Value)


    No aguardo,
    Abraço


    Última edição por ahteixeira em 30/10/2015, 09:36, editado 2 vez(es)
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 28/3/2015, 03:04

    Olá ATeixeira, boa noite.

    Penso que o problema está no fato do Windows 7 não possuir a Ocx TiffViewer Control.

    De qualquer forma o fato do seu modelo já exibir a janela onde seleciona-se a imagem tif já é um progresso.

    Abraços, WSenna
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  Alvaro Teixeira 28/3/2015, 11:11

    Olá, quanto ao ocx, não o tenho para testar.
    Normalmente não utilizo no meus projectos ocx de terceiros. Acho que não tenho nenhum projecto a usar, nem o calendário.
    Recentemente fiz upgrade do runtime na minha empresa (2003 para 2007) no 8.1 e resolveu os problemas que estava a ter com o 8.1., os restantes postos está tudo com runtime 2003 com Windows 7.
    Ficamos aguardar se algum colega pode ajudar.
    Entretanto, se o seu windows 7 é de 64, veja link abaixo:
    http://www.exceldoseujeito.com.br/2012/08/30/como-registrar-uma-dll-particular-para-incluir-na-sua-macro-vba/
    Abraço
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 28/3/2015, 12:48

    Valew Teixeira.

    Meu Windows 7 é 32.
    A propósito, numa pesquisa na internet verifiquei que esta ocx Tiff Viewer era produzida pela KODAK e de alguma forma fazia parte do MS Access 2003, só que nas versões mais novas do Access 2003 isso não ocorre mais.

    Continuarei pesquisando a forma anterior.

    Abraços, WSenna


    Última edição por wsenna em 3/4/2015, 05:12, editado 1 vez(es)
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  Alvaro Teixeira 28/3/2015, 21:39

    Olá, veja link abaixo:
    http://en.wikipedia.org/wiki/Microsoft_Office_Document_Imaging
    Entretanto, no exemplo que postou e retornei alterado, falta a funcao ContaFicheirosExtraiNome
    Para testar, está a fazer falta.
    Poderia disponibilizar tambem printScreen das referencias utilizadas no XP
    Abraço
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 28/3/2015, 22:09

    Grande Teixeira, boa noite.

    Amigão, andei fazendo umas pesquisas e descobri uma outra Ocx, a Image Viewer CP ActiveX Control e apliquei no meu frmVizo2 e a coisa funcionou meio que legal. O único problema agora é dar um jeito de fazer os dados dos campos TIFF Tag Data se auto-preencherem, o que no Windows XP funciona plenamente.
    Outra, na verdade a função referida é a ContaFicheiros que se encontra no módulo BASContaFicheiros. Esta função é utilizada para a captura do caminho onde estão armazenadas as imagens tif, e no momento não fará falta ao problema que estamos procurando sanar.


    Abraços, WSenna


    Última edição por wsenna em 3/4/2015, 05:13, editado 1 vez(es)
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  Alvaro Teixeira 29/3/2015, 23:58

    Olá wsenna, olha o que encontrei:
    http://kakopa.com/imaging/
    Abraço
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 30/3/2015, 01:52

    Grande Teixeira, boa noite.

    Amigão, fiz a instalação como você sugeriu acima, mas a coisa ainda não está se comportando como no Windows XP.
    Observei que falta a ocx tiff wiewer, substitui pela Image Viewer CP ActiveX Control e aí a imagem tif até apareceu mas os metadados da imagem não são preenchidos nos campos TIFF TAG DATA.

    Abraços, WSenna
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  Alvaro Teixeira 30/3/2015, 08:16

    Bom dia,
    O melhor talvez seja numa máquina em XP em que tudo esteja a funcionar, verificar as dependências, copiar ficheiros e replicar no windows 7.
    Pode estar a faltar algum componente que efectue a leitura das TAG.
    Abraço
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  wsenna 1/4/2015, 18:11

    Olá Teixeira e todas as Feras de plantão, boa tarde.

    Depois de literalmente "Torrar alguns milhões de neurônios" consegui na web um aplicativo que instala a TiffViewer.ocx que faltava para o Windows 7.
    Assim sendo, disponibilizo o novo OpenFileNameTeste.mdb para estudos.
    Lembrem-se de que se trata de um banco de dados feito em Access 2003 e que está a rodar no Windows 7 Professional.

    Link:  https://drive.google.com/file/d/0B9lRuJVSt5FGR3ZPU18wWWRRc1k/view?usp=sharing

    Observem que o formulário inicial é destinado a executar a captura das imagens (caminho) ou expurgar todas elas.
    Após a captura o sistema poderá exibir num formulário de Pesquisa Avançada o nome de cada aluno e ao ser localizado, u,m duplo click sobre ele exibira um outro formulário onde você terá a imagem de capa (documento digitalizado) e se esse documento for multi-paginado todas as demais páginas serão exibidas por ocasião da impressão.

    Por motivos óbvios só deixei o número de 16 alunos em apenas três cursos para exemplificação.

    Abraços, WSenna


    Última edição por wsenna em 3/4/2015, 05:10, editado 1 vez(es)
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  Alvaro Teixeira 2/4/2015, 11:37

    Olá wsenna.
    Era mesmo os componentes que faltava.
    Obrigado pelo retorno e também por disponibilizar aqui para o fórum a instalação dos componentes.
    Abraço

    Conteúdo patrocinado


    [Resolvido]clsCommonDialog não funfa no Windows 7 Empty Re: [Resolvido]clsCommonDialog não funfa no Windows 7

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 28/3/2024, 19:00