MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    Rodar som

    avatar
    msilveir
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 273
    Registrado : 13/03/2011

    Rodar som  Empty Rodar som

    Mensagem  msilveir em 4/5/2020, 15:30

    Ola pessoal

    tenho esse código que fica um campo com cor me pediram para executar um som com da cor

    Select Case txtTipo_de_Transferência.Value

    Case Is = "TRANSFERÊNCIA ENTRE FILIAIS"
    Me.txtTipo_de_Transferência.BackColor = RGB(107, 35, 142)
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "MERCADORIA ENTREGUE COM AVARIA"
    Me.txtTipo_de_Transferência.BackColor = vbYellow = amarelo
    Me.txtTipo_de_Transferência.ForeColor = vbBlack

    Case Is = "VENCIMENTO PRÓXIMO (Política de Devolução)"
    Me.txtTipo_de_Transferência.BackColor = vbRed
    Me.txtTipo_de_Transferência.ForeColor = vbWhite


    Case Is = "RECALL DA INDÚSTRIA"
    Me.txtTipo_de_Transferência.BackColor = vbBlue
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "CORTE 180 DIAS PERFUMARIA"
    Me.txtTipo_de_Transferência.BackColor = RGB(33, 94, 33)
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "CORTE 180 DIAS MEDICAMENTO"
    Me.txtTipo_de_Transferência.BackColor = RGB(33, 94, 33)
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "VENCIMENTO"
    Me.txtTipo_de_Transferência.BackColor = vbRed
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "EXCESSO DE MERCADORIA"
    Me.txtTipo_de_Transferência.BackColor = RGB(33, 94, 33)
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "DAD(Devolução Autorizada para o Disponível)"
    Me.txtTipo_de_Transferência.BackColor = RGB(33, 94, 33)
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "Problema de Fabricação"
    Me.txtTipo_de_Transferência.BackColor = RGB(211, 211, 211)
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "DAI (Devolução Autorizada para o Indisponível)"
    Me.txtTipo_de_Transferência.BackColor = RGB(255, 165, 0)
    Me.txtTipo_de_Transferência.ForeColor = vbWhite

    Case Is = "PRODUTOS SEM NF(Sobra de Loja)"
    Me.txtTipo_de_Transferência.BackColor = RGB(0, 255, 255)
    Me.txtTipo_de_Transferência.ForeColor = vbBlack

    Case Is = "DIVERGÊNCIA DE MERCADORIAS"
    Me.txtTipo_de_Transferência.BackColor = RGB(0, 255, 255)
    Me.txtTipo_de_Transferência.ForeColor = vbBlack

    End Select
    FranklinJSP
    FranklinJSP
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Anónimo
    Mensagens : 362
    Registrado : 25/02/2016

    Rodar som  Empty Re: Rodar som

    Mensagem  FranklinJSP em 8/5/2020, 16:52

    Bom día Marcio

    Form:
    Código:
    Case Is = "TRANSFERÊNCIA ENTRE FILIAIS"
    Me.txtTipo_de_Transferência.BackColor = RGB(107, 35, 142)
    Me.txtTipo_de_Transferência.ForeColor = vbWhite
    PlayMusic (Application.CurrentProject.Path & "\Alarm1.mp3")

    Case Is = "MERCADORIA ENTREGUE COM AVARIA"
    Me.txtTipo_de_Transferência.BackColor = vbYellow = amarelo
    Me.txtTipo_de_Transferência.ForeColor = vbBlack
    PlayMusic (Application.CurrentProject.Path & "\Alarm2.mp3")

    Modulo:
    Código:
    Option Compare Database
    Option Explicit

    #If VBA7 And Win64 Then
        Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _
                                "mciSendStringA" (ByVal lpstrCommand As String, _
                                 ByVal lpstrReturn As String, ByVal uReturnLength As Long, _
                                 ByVal hwndCallback As Long) As Long
    #Else
        Private Declare Function mciSendString Lib "winmm.dll" Alias _
                                "mciSendStringA" (ByVal lpstrCommand As String, _
                                 ByVal lpstrReturn As String, ByVal uReturnLength As Long, _
                                 ByVal hwndCallback As Long) As Long
    #End If

    Function PlayMusic(strMusicFile As String)
    On Error GoTo Salir

    Dim cmd As String, MusicType As String
    Dim ret

        If Dir(strMusicFile) = "" Then
            MsgBox "¡Archivo de audio no válido!", vbInformation, "Imposible reproducir"
            Exit Function
        End If

        MusicType = UCase(Right$(strMusicFile, 3))
        
        Select Case MusicType
        Case "MID"
            cmd = "open """ & strMusicFile & """ type sequencer alias myaudio"
        Case "MP3"
            cmd = "open " & """" & strMusicFile & """" & " alias myaudio"
        Case "WAV"
            cmd = "open " & """" & strMusicFile & """" & " alias myaudio"
        Case "WPL"
            cmd = "open " & """" & strMusicFile & """" & " alias myaudio"
        Case Else
            GoTo Salir
        End Select

        Call StopMusic

        ret = mciSendString(cmd, 0&, 0, 0)
        If ret <> 0 Then
            MsgBox "Hubo un error en la reproducción del archivo '" & strMusicFile & _
                   "'." & vbCrLf & vbCritical, "ERROR"
        Else
            cmd = "Play myaudio"
            ret = mciSendString(cmd, vbNullString, 0, 0)
        End If
        Exit Function

    Salir:
    End Function

    Function StopMusic()
    Dim ret
        ret = mciSendString("close myaudio", vbNullString, 0, 0)
    End Function

    Saludos


    Última edição por FranklinJSP em 8/5/2020, 16:54, editado 1 vez(es) (Razão : Faltou código)


    .................................................................................
    Meu Português não é muito bom,
    mas eu gosto de colaborar... em qualquer idioma
    Smile "Access... minha paixão"

      Data/hora atual: 16/7/2020, 13:49