[Resolvido]Por que a tela do MS Paint usando VBA abre preta?

Boa tarde

Desejaria entender e resolver o porque da tela do MS Paint abrir preta com uso o VBA para comandar a abertura da mesma já num desenho.

referencia ao outro post
https://www.maximoaccess.com/t27014-resolvidoimagem-abre-na-cor-preta#190342

Obrigado a quem puder ajudar.

Ola;

Faça o teste com esta minha função;

Código:

Function AbreImagemNoPaint(strCaminho)
Shell Chr(34) & "C:\Windows\System32\mspaint.exe" & Chr(34) & " " & _
Chr(34) & strCaminho & Chr(34), 1
If Err.Number = 0 Then Exit Function
Exit Function
End Function


Chamar a função:

Call AbreImagemNoPaint(CurrentProject.Path & "\SuaPasta\SuaFoto.jpg")

Bom dia
JPaulo
Já sai para o trabalho, quando chegar em casa testo e aviso.
Obrigado

Me esqueci.
Como posso informar para a foto seja procurada no local onde o programa se encontra, dentro da pasta imagem?

Editado na mensagem Nº2

JPaulo.
Funcionou perfeitamente.
Poderia explicar o porque do erro?
Outra coisa....
não abusando muito....
rs
Teria como ajudar em outra questão?
Obrigado

No aplicativo desenvolvido pelo AhTeixeira ....
https://www.maximoaccess.com/t23239-duvida-com-imagem-no-formulario
existe a função que ele criou para ver o desenho no paint.
No meu abre tela preta.

tentei adaptar a que vc deu a dica mas não deu certo.
Continua a abrir tela preta.
ficou assim....


Function fncMostraFoto()
'para mostra a imagem associada oa registo
'2015 - ahteixeira
Shell Chr(34) & "C:\Windows\System32\mspaint.exe" & Chr(34) & " " & _
Chr(34) & strCaminho & Chr(34), 1
If Err.Number = 0 Then
End If
If Len(Dir(Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg", 1)) > 0 Then
Me.foto.Picture = Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg"
Else
Me.foto.Picture = Application.CurrentProject.Path & "\Imagens\" & "naoexiste.jpg"
End If
End Function

Poderia ajudar?

No VBA desse form, cole a função que te passei;

Código:

Public Function AbreImagemNoPaint(strCaminho)
    Shell Chr(34) & "C:\Windows\System32\mspaint.exe" & Chr(34) & " " & _
    Chr(34) & strCaminho & Chr(34), 1
    If Err.Number = 0 Then Exit Function
    Exit Function
End Function

Ao pressionar duas vezes na imagem, altere assim e teste;

Código:

Private Sub foto_DblClick(Cancel As Integer)
'abrir foto no paint
'2015 - ahteixeira

    If Len(Dir(Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg", 1)) > 0 Then
      ' Dim RetVal
        'RetVal = Shell("MSPAINT.EXE" & Space(1) & Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg", 1)
        Call AbreImagemNoPaint(CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg")
    Else
        'se nao existir ficheiro, pergunta se preterde criar novo
        If MsgBox("Deseja criar Ortondontia nova?", vbExclamation + vbYesNo, "Não existe ficheiro associado.") = vbYes Then
           
            Dim fOrigem, fDestino
            fOrigem = Application.CurrentProject.Path & "\Imagens\modelo.jpg"
            fDestino = Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg"
            'copia
            FileCopy fOrigem, fDestino
           
            'para atualizar/refrescar foto
            'Call fncMostraFoto
        Call AbreImagemNoPaint(CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg")
        End If
    End If

End Sub

JPaulo
Obrigado antes de mais nada.
estou no plantão do hospital ate +- 15 h.
Consigo acessar internet pelo telefone, mas meu telefone não roda access, e não conseguirei testar.
De tanto buscar algo que possa permitir abrir um esquema de desenho de exame de corpo delito em humanos, coloquei alguns códigos em word no telefone para estudar, entre um ou outro paciente.

Dentro de tudo que encontrei o que mais se encaixa é a aplicação.....signature.....retirada do forum utteraccess, em anexo.
Desenvolveram para imprimir assinaturas realizadas em tablet. Usa a classe desenvolvida pelo stephen Lebans.
Até tentei trocar a imagem por outra, mas ai envolve aspectos complexos e difíceis para eu resolver. Não possuo conhecimento para isso. Mas encaixa perfeitamente.
Daí optei pelo exemplo do Ah Teixiera, e cá estamos.
rs

Todavia meu receio é que como vc teve que modificar a rotina para ajudar-me, trocando certos comandos, pode ser que os outros interligados não rodem.
Exemplo....

Private Sub Form_Current()
   'para atualizar a imagem ao navegar nos registos
   Call fncMostraFoto
End Sub


Private Sub cmdRefrecar_Click()
   'para atualizar/refrescar foto
   Call fncMostraFoto    
End Sub


Acrescento abaixo a codificação principal original e o exemplo signature com os desenhos/esquemas que preciso.
acredito que posa ser útil.
de qualquer forma meu muito obrigado pela sua valorosa ajuda,


Function fncMostraFoto()
'para mostra a imagem associada oa registo
'2015 - ahteixeira

   If Len(Dir(Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg", 1)) > 0 Then
       Me.foto.Picture = Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg"
   Else
       Me.foto.Picture = Application.CurrentProject.Path & "\Imagens\" & "naoexiste.jpg"
   End If
   
End Function

Private Sub Form_Current()
   'para atualizar a imagem ao navegar nos registos
   Call fncMostraFoto
End Sub

Private Sub foto_DblClick(Cancel As Integer)
'abrir foto no paint
'2015 - ahteixeira

   If Len(Dir(Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg", 1)) > 0 Then
       Dim RetVal
       RetVal = Shell("MSPAINT.EXE" & Space(1) & Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg", 1)
   Else
       'se nao existir ficheiro, pergunta se preterde criar novo
       If MsgBox("Deseja criar Ortondontia nova?", vbExclamation + vbYesNo, "Não existe ficheiro associado.") = vbYes Then
           
           Dim fOrigem, fDestino
           fOrigem = Application.CurrentProject.Path & "\Imagens\modelo.jpg"
           fDestino = Application.CurrentProject.Path & "\Imagens\" & Me.ID & ".jpg"
           'copia
           FileCopy fOrigem, fDestino
           
           'para atualizar/refrescar foto
           Call fncMostraFoto
       End If
   End If


End Sub
Private Sub cmdRefrecar_Click()
   'para atualizar/refrescar foto
   Call fncMostraFoto
End Sub

Private Sub Buscar_AfterUpdate()
Lista57.Requery
End Sub

Private Sub Buscar_Change()
If VarTecla = 1 Then
VarTecla = 0
Else
Me.Recalc
SendKeys "{F2}"
End If
End Sub



Private Sub Form_Open(Cancel As Integer)
DoCmd.GoToRecord , , acNewRec
End Sub

Private Sub Limpar_Click()
Buscar = ""
Lista57.Requery
End Sub

JPaulo
Deu divergência.
Acredito que seja pelo exposto antes.
Obrigado.

Sim.
Penso em ter um form com nome da pessoa e um esquema do corpo delito em branco, sem marcação nenhuma.
Abriria o paint e faria as marcações necessarias. Ao final salvaria. Qdo fosse consultar veria as lesoes. E claro imprimiria.

Tô pensano nela. To tentando acrescentar mais opcoes de marcação.
Tipo círculo. ...
No final da tarde. Dou um retorno.
Obrigado

Boa noite Avelino, JPaulo e demais....
Avelino sua dica do vete é muito interessante, modifiquei o desenho e acrescentei um dos que preciso.
percebi que não teria uma rapidez quando precisasse marcar no desenho as lesões encontradas. Teria que acrescentar muitas marcações em toda a extensão do desenho.
Se puder verificar vai poder ver na mudança apenas do desenho.

Na solução do Ah Teixeira, troquei o desenho e a mensagem.

Quebrei a cabeça a tarde inteira para tentar colocar a rotina do JPaulo, que faz com que o MS Paint não abra na cor preta.


Public Function AbreImagemNoPaint(strCaminho)
   Shell Chr(34) & "C:\Windows\System32\mspaint.exe" & Chr(34) & " " & _
   Chr(34) & strCaminho & Chr(34), 1
   If Err.Number = 0 Then Exit Function
   Exit Function
End Function


Mas não consegui.
Se alguém puder... resolver essa minha dificuldade, vai ajudar muito.

Em anexo o vete do Avelino e a solução do Ah Teixeira.

Agora porque o Paint abre na cor preta?

Obrigado

OK
Vou voltar e estudar mais um pouco.
Rs.
Obrigado.

Avelino, tinha visto o exemplo primário e não as adaptações que vc criou!

Obrigado e desculpe não ter percebido.

Penso, que o trabalho braçal para espalhar no campo todo, valerá se puder adotar uma pequena alteração ....
Não basta apenas escolher pelo número, o que penso seria deixar os campos a mostra com a cor exemplo verde e se fosse tipo cicatriz a pessoa escolhe vermelho, se for queimadura.... amarelo e mais algumas cores.
Em áreas extensas como a barriga (abdome) teria que replicar muitos campos, mas vejo como viável.
teria como vc montar um campo apenas como exemplo?
deixando visível e ao clicar escolho a cor?

Lembrei do exemplo do odontograma!!!!
Vi que que já está do jeito que pedi a vc.
rsrs

Só para finalizar....
pergunto uma coisa e peço outra;
Qual a rotina que posso usar para zerar todas as cores num cadastro novo?
E pergunto...
Porque não consigo visualizar os quadrados por cima da figura que coloquei?

em anexo
.
obrigado

Mylton,

mudei o projeto novamente.  Agora vc poderá movimentar com o mouse os pontos, livremente, sobre o desenho.  Volte ao tópico e baixe o último arquivo

Aguardamos

Perfeito.
Só falta uma coisa.
Rs
Como posso trocar as cores?
Exemplo..
rubor --- vermelho.
hematoma ---roxo
queimadura --- laranja
cicatriz --- azul

Mylton,

Amanhã, pela manha, eu monto isso pra vc e te comunico

Obrigado.
Uma excelente noite.
Gde abs.

Meu amigo. Show.
Se quiser aumentar o número de marcações basta adaptar, certo?
Agora só falta nosso tricolor ser campeão esse ano.
Rs.

Avelino
Acrescentei....
amputação, ferida e edema e ...dobrei para 20 cada um.
Pq?
Pq existe uma probabilidade maior de haver maios lesões.


bom ta dando erro...

Public Sub fncMontaEventos()
Dim ctl As Control
For j = 1 To 20
   Me("rot" & j).OnMouseUp = "=fncMouseUp([" & Me("rub" & j).Name & "]," & j & ")"
   Me("rot" & j + 20).OnMouseUp = "=fncMouseUp([" & Me("hem" & j).Name & "]," & j + 20 & ")"
   Me("rot" & j + 40).OnMouseUp = "=fncMouseUp([" & Me("que" & j).Name & "]," & j + 40 & ")"
   Me("rot" & j + 60).OnMouseUp = "=fncMouseUp([" & Me("cic" & j).Name & "]," & j + 60 & ")"
  Me("rot" & j + 80).OnMouseUp = "=fncMouseUp([" & Me("ede" & j).Name & "]," & j + 80 & ")"
   Me("rot" & j + 100).OnMouseUp = "=fncMouseUp([" & Me("fer" & j).Name & "]," & j + 100 & ")"
   Me("rot" & j + 120).OnMouseUp = "=fncMouseUp([" & Me("amp" & j).Name & "]," & j + 120 & ")"
Next
For j = 1 To 20
   Me("rot" & j).OnDblClick = "=fncDuploClique([" & Me("rot" & j).Name & "]," & p1 & ")"
   Me("rot" & j + 20).OnDblClick = "=fncDuploClique([" & Me("rot" & j + 20).Name & "]," & p2 & ")"
   Me("rot" & j + 40).OnDblClick = "=fncDuploClique([" & Me("rot" & j + 40).Name & "]," & p3 & ")"
   Me("rot" & j + 60).OnDblClick = "=fncDuploClique([" & Me("rot" & j + 60).Name & "]," & p4 & ")"
   Me("rot" & j + 80).OnDblClick = "=fncDuploClique([" & Me("rot" & j + 80).Name & "]," & p5 & ")"
   Me("rot" & j + 100).OnDblClick = "=fncDuploClique([" & Me("rot" & j + 100).Name & "]," & p6 & ")"
   Me("rot" & j + 120).OnDblClick = "=fncDuploClique([" & Me("rot" & j + 120).Name & "]," & p7 & ")"
Next
End Sub

o que fiz de errado?
rs;rs;

Em anexo o banco.

Muito obrigado.
Não tenho palavras para lhe agradecer por essa imensa ajuda.
Gde abs e sucesso.
Boa semana.