MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Tamannho arquivo de imagem vinculado

    Compartilhe

    wmantovani
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 99
    Registrado : 06/09/2011

    [Resolvido]Tamannho arquivo de imagem vinculado

    Mensagem  wmantovani em Qui 13 Nov 2014, 16:38

    boa tarde a todos, estou o utilizo o seguinte VBA pego aqui no forum, me perdoem pois nao lembro quem disponibilizou..funcionando perfeitamente, agora quero aprimora-lo, quero algo que verifique o tamanho do arquivo, se for menor que 640K, ele deixe salvar o vinculo, senão, exibir a mensagem do tamanho do arquivo e pedir para que o usuário reduza


    Dim strCaminho As String, strPastaInicial As String
    strPastaInicial = "\\dara-01\Diversos\VISTORIACAÇAMBAS\"
    strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
    "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
    If Len(strCaminho) > 0 Then
    Me.LocalFoto = strCaminho
    Me.Foto.Picture = Me.LocalFoto



    tentei juntar com esse outro Vba, que o grando Jpaulo publicou mas estou empacando em algo


    'Requer ativa a referencia VBA
    'Microsoft Scripting Runtime
    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject
    Dim File As Scripting.File
    Dim strCaminho As String
    Dim fileSize As String

    strCaminho = "D:\teste.jpg"

    If FSO.FileExists(strCaminho) Then
    Set File = FSO.GetFile(strCaminho)

    fileSize = Format(File.Size / 1000000, "#,##0.00") & " " & "Megas"
    MsgBox fileSize
    End If

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Tamannho arquivo de imagem vinculado

    Mensagem  Roberto_1977 em Ter 18 Nov 2014, 09:18

    Bom dia,

    É um pouco complicado sem a sua BD, mas tente com código abaixo... não testado. Embarassed


    Dim strCaminho As String, strPastaInicial As String
    Dim FSO As Object
    Dim File As Object
    Dim fileSize As String
    strPastaInicial = "C:\"
    strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
    "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
    If Len(strCaminho) > 0 Then
    Me.LocalFoto = strCaminho
    Me.Foto.Picture = Me.LocalFoto
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(strCaminho) Then
    Set File = FSO.GetFile(strCaminho)
    fileSize = Format(File.Size / 1000000, "#,##0.00") & " " & "Megas"
    If File.Size < 640000 Then ' Aqui introduz o tamanho maximo que limite seu criterio 640K
    MsgBox fileSize
    DoCmd.Close , , acSavePrompt
    Else
    MsgBox "Imagem demasiado grande" & " " & fileSize & vbCrLf & "Tamanho maximo 640K", vbInformation, "Informação"
    End If
    End If

    wmantovani
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 99
    Registrado : 06/09/2011

    Re: [Resolvido]Tamannho arquivo de imagem vinculado

    Mensagem  wmantovani em Ter 18 Nov 2014, 11:23

    Caro Roberto_1977, deu certo adaptei, ficou show, agora o trampo maior vai ser ensinar os funcionários a redimensionar o tamanho das fotos, muito obrigado pela ajuda....


    Show..

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Tamannho arquivo de imagem vinculado

    Mensagem  Roberto_1977 em Ter 18 Nov 2014, 11:32

    Bom dia,

    Fico contente que tenha funcionado... Cool

    Sempre ao dispor..


      Data/hora atual: Sab 03 Dez 2016, 02:27