Ficha nº29

1.

Código:

Private Sub Command1_Click()

    On Error GoTo TrataErroDivisao

    Dim num As Integer, den As Integer, res As Single

    Picture1.Cls

    

    num = Val(InputBox("Introduza o numerador:", "Dados"))

    den = Val(InputBox("Introduza o denominador:", "Dados"))

    res = num / den

    Picture1.Print res

    

TrataErroDivisao:

    Select Case Err.Number

    Case 11

        If MsgBox("Não existe divisão por zero.", vbYesNo, "Aviso") = vbYes Then

            den = Val(InputBox("Informe o valor do denominador"))

            Resume

        Else

            Exit Sub

        End If

    End Select

End Sub

Ficha nº28

1.

Código:

Private Sub Bloquear()

    Text1.Enabled = False

    Text2.Enabled = False

    Text3.Enabled = False

    Text4.Enabled = False

End Sub

Private Sub Desbloquear()

    Text1.Enabled = True

    Text2.Enabled = True

    Text3.Enabled = True

    Text4.Enabled = True

End Sub

Private Sub Limpar()

    Text1.Text = ""

    Text2.Text = ""

    Text3.Text = ""

    Text4.Text = ""

End Sub

Private Sub Command1_Click()

    If Command1.Caption = "Novo" Then

        Data1.Recordset.AddNew

        Desbloquear

        Limpar

        Command2.Enabled = True

        Command3.Enabled = False

        Command4.Enabled = False

        Command5.Enabled = False

        Command6.Enabled = False

        Command7.Enabled = False

        Command8.Enabled = False

        Command9.Enabled = False

        Command1.Caption = "Cancelar"

    Else

        Data1.Recordset.CancelUpdate

        Bloquear

        Command2.Enabled = False

        Command3.Enabled = True

        Command5.Enabled = True

        Command4.Enabled = True

        Command6.Enabled = True

        Command7.Enabled = True

        Command8.Enabled = True

        Command9.Enabled = True

        Command1.Caption = "Novo"

    End If

End Sub

Private Sub Command2_Click()

    If Text1.Text = "" Then

        MsgBox "Preencha o nome", vbCritical, "Aviso"

        Text1.SetFocus

    ElseIf Text3.Text = "" Then

        MsgBox "Preencha o número de sócio", vbCritical, "Aviso"

        Text3.SetFocus

    ElseIf Text4.Text = "" Then

        MsgBox "Preencha a quota", vbCritical, "Aviso"

        Text4.SetFocus

    Else

        Data1.Recordset.Update

        Command1.Caption = "Novo"

        Command3.Caption = "Editar"

        Bloquear

        Command2.Enabled = False

        Command3.Enabled = True

        Command5.Enabled = True

        Command4.Enabled = True

        Command6.Enabled = True

        Command7.Enabled = True

        Command8.Enabled = True

        Command9.Enabled = True

        Command1.Enabled = True

    End If

End Sub

Private Sub Command3_Click()

    If Command3.Caption = "Editar" Then

        Data1.Recordset.Edit

        Desbloquear

        Command2.Enabled = True

        Command1.Enabled = False

        Command4.Enabled = False

        Command5.Enabled = False

        Command6.Enabled = False

        Command7.Enabled = False

        Command8.Enabled = False

        Command9.Enabled = False

        Command3.Caption = "Cancelar"

    Else

        Data1.Recordset.CancelUpdate

        Bloquear

        Command2.Enabled = False

        Command1.Enabled = True

        Command4.Enabled = True

        Command5.Enabled = True

        Command6.Enabled = True

        Command7.Enabled = True

        Command8.Enabled = True

        Command9.Enabled = True

        Command3.Caption = "Editar"

    End If

End Sub

Private Sub Command4_Click()

    Dim p As String, n As Integer

    

    n = 0

    

    p = UCase(InputBox("Que modalidade deseja procurar?", "Procura"))

    If Trim(p) <> "" Then

        Data1.Recordset.MoveFirst

        Do While Not Data1.Recordset.EOF

            If n = 0 Then

                Data1.Recordset.FindFirst "modalidade='" & p & "'"

                n = 1

                MsgBox "Registo encontrado", vbInformation, "Registo"

                If Data1.Recordset.NoMatch = True Then

                    MsgBox "Não existe esse registo", vbCritical, "Aviso"

                    Exit Do

                End If

            End If

            If n = 1 Then

                Data1.Recordset.FindNext "modalidade='" & p & "'"

                If Data1.Recordset.NoMatch = True Then

                    MsgBox "Não existem mais registos", vbCritical, "Aviso"

                    Exit Do

                End If

            End If

        Loop

    End If

End Sub

Private Sub Command5_Click()

    Data1.Recordset.MoveLast

End Sub

Private Sub Command6_Click()

    Data1.Recordset.MovePrevious

    If Data1.Recordset.BOF Then

        Data1.Recordset.MoveFirst

    End If

End Sub

Private Sub Command7_Click()

    Data1.Recordset.MoveNext

    If Data1.Recordset.EOF Then

        Data1.Recordset.MoveLast

    End If

End Sub

Private Sub Command8_Click()

    Data1.Recordset.MoveFirst

End Sub

Private Sub Command9_Click()

    Data1.Recordset.Delete

    MsgBox "Registo eliminado", vbInformation, "Eliminado"

    Data1.Recordset.MoveNext

    If Data1.Recordset.EOF Then

        Data1.Recordset.MovePrevious

        If Data1.Recordset.BOF Then

            MsgBox "Não há resgistos!", vbCritical, "Aviso"

            Command9.Enabled = False

        End If

    End If

End Sub

Private Sub Form_Load()

    Bloquear

    Command2.Enabled = False

End Sub

Ficha nº27

1.

Código:

Private Sub Command1_Click()
    If Command1.Caption = "Novo" Then
        Data1.Recordset.AddNew
        Desbloquear
        Limpar
        Text1.SetFocus
        Command2.Enabled = False
        Command4.Enabled = False
        Command7.Enabled = False
        Command8.Enabled = False
        Command9.Enabled = False
        Command10.Enabled = False
        Command12.Enabled = False
        Command1.Caption = "Cancelar"
    Else
        Data1.Recordset.CancelUpdate
        Bloquear
        Command2.Enabled = True
        Command4.Enabled = True
        Command7.Enabled = True
        Command8.Enabled = True
        Command9.Enabled = True
        Command10.Enabled = True
        Command12.Enabled = True
        Command1.Caption = "Novo"
    End If
End Sub

Private Sub Command10_Click()
    Data1.Recordset.MoveLast
End Sub

Private Sub Command11_Click()
    Form2.Show
End Sub

Private Sub Command12_Click()
    MsgBox "Registo eliminado!", vbInformation, "Eliminado"
    Data1.Recordset.Delete
    Data1.Recordset.MoveNext
    If Data1.Recordset.EOF Then
        Data1.Recordset.MovePrevious
        If Data1.Recordset.BOF Then
            MsgBox "Não há registos!", vbCritical, "Aviso"
            Command12.Enabled = False

        End If
    End If
End Sub

Private Sub Command2_Click()
    If Command2.Caption = "Editar" Then
        Desbloquear
        Data1.Recordset.Edit
        Command1.Enabled = False
        Command12.Enabled = False
        Command4.Enabled = False
        Command7.Enabled = False
        Command8.Enabled = False
        Command9.Enabled = False
        Command10.Enabled = False
        Command2.Caption = "Cancelar"
    Else
        Data1.Recordset.CancelUpdate
        Bloquear
        Command1.Enabled = True
        Command12.Enabled = True
        Command4.Enabled = True
        Command7.Enabled = True
        Command8.Enabled = True
        Command9.Enabled = True
        Command10.Enabled = True
        Command2.Caption = "Editar"
    End If
End Sub

Private Sub Command4_Click()
    Dim p As String
   
    p = UCase(InputBox("Introduza o nome que quer pesquisar", "Pesquisar"))
    If Trim(p) <> "" Then
        Data1.Recordset.FindFirst "nome='" & p & "'"
        If Data1.Recordset.NoMatch = True Then
            MsgBox "Não existe esse registo", vbCritical, "Aviso"
            Data1.Recordset.MoveFirst
        End If
    End If
End Sub

Private Sub Command5_Click()
    If MsgBox("Deseja sair?", vbQuestion + vbYesNo, "Sair") = vbYes Then
        End
    End If
End Sub

Private Sub Command6_Click()
    If Text1.Text = "" Then
        MsgBox "Preencha o campo do número", vbCritical, "1º campo"
        Text1.SetFocus
    ElseIf Text2.Text = "" Then
        MsgBox "Preencha o campo do nome", vbCritical, "2º campo"
        Text2.SetFocus
    ElseIf Text3.Text = "" Then
        MsgBox "Preencha o campo da morada", vbCritical, "3º campo"
        Text3.SetFocus
    ElseIf Text4.Text = "" Then
        MsgBox "Preencha o campo do telefone", vbCritical, "4º campo"
        Text4.SetFocus
    ElseIf Text5.Text = "" Then
        MsgBox "Preencha o campo do código postal", vbCritical, "5º campo"
        Text5.SetFocus
    ElseIf Text6.Text = "" Then
        MsgBox "Preencha o campo da localidade", vbCritical, "6º campo"
        Text6.SetFocus
    Else
        MsgBox "Os dados foram guardados!", vbInformation, "Informação"
        Data1.Recordset.Update
        Bloquear
        Command1.Enabled = True
        Command2.Enabled = True
        Command4.Enabled = True
        Command7.Enabled = True
        Command8.Enabled = True
        Command9.Enabled = True
        Command10.Enabled = True
        Command12.Enabled = True
        Command1.Caption = "Novo"
        Command2.Caption = "Editar"
    End If
End Sub

Private Sub Command7_Click()
    Data1.Recordset.MoveFirst
End Sub

Private Sub Command8_Click()
    Data1.Recordset.MovePrevious
    If Data1.Recordset.BOF Then
        Data1.Recordset.MoveFirst
    End If
End Sub

Private Sub Command9_Click()
    Data1.Recordset.MoveNext
    If Data1.Recordset.EOF Then
        Data1.Recordset.MoveLast
    End If
End Sub

Private Sub Form_Load()
    Bloquear
End Sub

Private Sub Timer1_Timer()
    Label6.Caption = Time()
    Label7.Caption = Date
End Sub

Private Sub Bloquear()
    Text1.Enabled = False
    Text2.Enabled = False
    Text3.Enabled = False
    Text4.Enabled = False
    Text5.Enabled = False
    Text6.Enabled = False
End Sub

Private Sub Desbloquear()
    Text1.Enabled = True
    Text2.Enabled = True
    Text3.Enabled = True
    Text4.Enabled = True
    Text5.Enabled = True
    Text6.Enabled = True
End Sub

Private Sub Limpar()
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
End Sub

Ficha nº26

1.

Código:

rivate Sub Command1_Click()
    If Command1.Caption = "Adicionar" Then
        Data1.Recordset.AddNew
        Desbloquear
        Text1.SetFocus
        Command3.Enabled = False
        Command2.Enabled = True
        Command1.Caption = "Cancelar"
    Else
        Data1.Recordset.CancelUpdate
        Bloquear
        Command3.Enabled = True
        Command2.Enabled = False
        Command1.Caption = "Adicionar"
    End If
End Sub

Private Sub Command2_Click()
    If MsgBox("Deseja Guardar?", vbYesNo + vbQuestion, "Questão") = vbYes Then
        If Text1.Text = "" Then
            MsgBox "Preencha o primeiro campo", vbCritical, "Aviso"
            Text1.SetFocus
        ElseIf Text2.Text = "" Then
            MsgBox "Preencha o segundo campo", vbCritical, "Aviso"
            Text2.SetFocus
        ElseIf Text3.Text < 0 Or Text3.Text > 20 Then
            MsgBox "Nota inválida do primeiro trabalho", vbCritical, "Aviso"
            Text3.SetFocus
        ElseIf Text4.Text < 0 Or Text4.Text > 20 Then
            MsgBox "Nota inválida do primeiro trabalho", vbCritical, "Aviso"
            Text4.SetFocus
        Else
        Data1.Recordset.Update
        Bloquear
        Command2.Enabled = False
        Command3.Enabled = True
        Command1.Caption = "Adicionar"
        End If
    End If
End Sub

Private Sub Command3_Click()
    If MsgBox("Deseja eliminar?", vbYesNo + vbQuestion, "Questão") = vbNo Then
        MsgBox "Registo não eliminado!", vbInformation, "Informação"
    Else
        Data1.Recordset.Delete
        MsgBox "Registo eliminado!", vbInformation, "Informação"
        Data1.Recordset.MoveNext
        If Data1.Recordset.EOF Then
            Data1.Recordset.MovePrevious
            If Data1.Recordset.BOF Then
                MsgBox "Não há registos", vbInformation, "Informação"
                Command3.Enabled = False
            End If
        End If
    End If
End Sub

Private Sub Command4_Click()
    Data1.Recordset.MoveFirst
End Sub

Private Sub Command5_Click()
    Data1.Recordset.MovePrevious
    If Data1.Recordset.BOF Then
        Data1.Recordset.MoveFirst
    End If
End Sub

Private Sub Command6_Click()
    Data1.Recordset.MoveNext
    If Data1.Recordset.EOF Then
        Data1.Recordset.MoveLast
    End If
End Sub

Private Sub Command7_Click()
    Data1.Recordset.MoveLast
End Sub

Private Sub Bloquear()
    Text1.Enabled = False
    Text2.Enabled = False
    Text3.Enabled = False
    Text4.Enabled = False
End Sub

Private Sub Desbloquear()
    Text1.Enabled = True
    Text2.Enabled = True
    Text3.Enabled = True
    Text4.Enabled = True
End Sub

Private Sub Form_Load()
    Bloquear
    Command2.Enabled = False
End Sub

Ficha nº25

1.

Código:

Private Type Cliente

    Número As Integer

    Total_filmes As Integer

End Type

Dim tabela(1000) As Cliente, i As Integer, j As Integer, total_c As Integer, total_r As Single

Private Sub Command1_Click()

    If Text1.Text <> "" And Text2.Text <> "" Then

        MsgBox "O seu dados foram guardados!", vbInformation, "Guardado!"

        gravar_dados

        total_c = total_c + 1

        Label11.Caption = total_c

        Command1.Enabled = False

        total_r = total_r + Label9.Caption

        Label13 = total_r & " €"

        Command5.Enabled = True

        Command6.Enabled = True

    Else

        MsgBox "Preencha todos os campos!", vbCritical, "Aviso"

    End If

End Sub

Private Sub gravar_dados()

    tabela(j).Número = Text1.Text

    tabela(j).Total_filmes = Text2.Text

    

    i = j

    j = j + 1

End Sub

Private Sub Command2_Click()

    Text1.Text = ""

    Text2.Text = ""

    Label5.Caption = ""

    Label7.Caption = ""

    Label9.Caption = ""

    

    Command1.Enabled = True

End Sub

Private Sub Command3_Click()

    Form1.Hide

    Form2.Show

End Sub

Private Sub Command4_Click()

    Dim opcao As Integer

    

    opcao = MsgBox("Deseja sair?", vbQuestion + vbYesNo, "Confirmação")

    If opcao = vbYes Then

        End

    End If

End Sub

Private Sub Command5_Click()

    If i > 0 Then

        i = i - 1

        ver_dados (i)

    End If

End Sub

Private Sub ver_dados(x As Integer)

    Text1.Text = tabela(i).Número

    Text2.Text = tabela(i).Total_filmes

End Sub

Private Sub Command6_Click()

    If i < j - 1 Then

        i = i + 1

        ver_dados (i)

    End If

End Sub

Private Sub Form_Load()

    i = 0

    j = 0

    Command1.Enabled = False

    Command5.Enabled = False

    Command6.Enabled = False

End Sub

Private Sub Text2_Change()

    If Text2.Text <> "" Then

        Label5.Caption = Text2.Text * 2.5 & " €"

        Label7.Caption = Label5.Caption * 0.1 & " €"

        Label9.Caption = Label5.Caption - Label7.Caption & " €"

    End If

End Sub

Ficha nº24

1.

Código:

Private Type Funcionario

    Codigo As Integer

    Nome As String * 40

    salario As Long

    vale As Long

    Fotografia As String * 60

End Type

Dim tabela(12) As Funcionario

Dim i As Integer, j As Integer

Private Sub Command1_Click()

    If Text1.Text <> "" And Text2.Text <> "" And Text3.Text <> "" And Text4.Text <> "" And Text6.Text <> "" Then

        MsgBox "Dados inseridos", vbInformation + vbOKOnly, "Mensagem"

        Label7.Visible = False

        Text6.Visible = False

        Image1.Visible = True

        Image1.Picture = LoadPicture(Text6.Text)

        gravar_dados

        Command2.Enabled = True

        Command4.Enabled = True

        Command5.Enabled = True

        Command6.Enabled = True

        Command7.Enabled = True

    Else

        MsgBox "Preencha todos os campos", vbCritical, "Aviso"

    End If

End Sub

Private Sub Command2_Click()

    Text1.Text = ""

    Text2.Text = ""

    Text3.Text = ""

    Text4.Text = ""

    Text5.Text = ""

    Text6.Text = ""

    

    Image1.Visible = False

    Text6.Visible = True

    Label7.Visible = True

    Image1.Visible = False

End Sub

Private Sub Command3_Click()

    Dim opcao As Integer

    

    opcao = MsgBox("Deseja sair?", vbQuestion + vbYesNo, "Confirmação")

    If opcao = vbYes Then

        End

    End If

End Sub

Private Sub Command4_Click()

    If i < j - 1 Then

        i = i + 1

        ver_dados (i)

    End If

End Sub

Private Sub ver_dados(x As Integer)

    Text1.Text = tabela(x).Codigo

    Text2.Text = tabela(x).Nome

    Text3.Text = tabela(x).salario

    Text4.Text = tabela(x).vale

End Sub

Private Sub Command5_Click()

    If i > 0 Then

        i = i - 1

        ver_dados (i)

    End If

End Sub

Private Sub Command6_Click()

    Command1.Enabled = False

    Command4.Enabled = False

    Command5.Enabled = False

End Sub

Private Sub Command7_Click()

    MsgBox "As suas alterações foram guardadas", vbInformation, "Guardado!"

    

    Command1.Enabled = True

    Command4.Enabled = True

    Command5.Enabled = True

    

    tabela(i).Codigo = Text1.Text

    tabela(i).Nome = Text2.Text

    tabela(i).salario = Text3.Text

    tabela(i).vale = Text4.Text

    tabela(i).Fotografia = Text6.Text

End Sub

Private Sub gravar_dados()

    tabela(j).Codigo = Text1.Text

    tabela(j).Nome = Text2.Text

    tabela(j).salario = Text3.Text

    tabela(j).vale = Text4.Text

    tabela(j).Fotografia = Text6.Text

    

    i = j

    j = j + 1

End Sub

Private Sub Form_Load()

    i = 0

    j = 0

    

    Label6.Visible = False

    Text5.Visible = False

    

    If j = 0 Then

        Command2.Enabled = False

        Command4.Enabled = False

        Command5.Enabled = False

        Command6.Enabled = False

        Command7.Enabled = False

    End If

End Sub

Private Sub Text4_Change()

    Dim salario As Integer, vale As Integer

    Label6.Visible = True

    Text5.Visible = True

    

    salario = Text3.Text

    vale = Text4.Text

    

    Text5.Text = salario + vale & " €"

End Sub

Private Sub Timer1_Timer()

    Label1.Caption = Now()

End Sub

Teste Módulo 11

1.

Código:

Private Function Maior(x As Integer, y As Integer, z As Integer) As Integer

    If x > y And x > z Then

        Maior = x

    ElseIf y > x And y > z Then

        Maior = y

    Else

        Maior = z

    End If

End Function

Private Sub Command1_Click()

    Dim a As Integer, b As Integer, c As Integer

    

    Do

        a = Val(InputBox("Introduza o 1º valor:", "1º valor"))

        If a < 0 Then

            MsgBox "O valor introduzido é inválido", vbCritical, "Aviso"

        End If

    Loop While a < 0

    

    Do

        b = Val(InputBox("Introduza o 2º valor:", "2º valor"))

        If b < 0 Then

            MsgBox "O valor introduzido é inválido", vbCritical, "Aviso"

        End If

    Loop While b < 0

    

    Do

        c = Val(InputBox("Introduza o 3º valor:", "3º valor"))

        If c < 0 Then

            MsgBox "O valor introduzido é inválido", vbCritical, "Aviso"

        End If

    Loop While c < 0

    

    MsgBox "O maior valor é " & Maior(a, b, c) & ".", vbInformation, "Resultado"

End Sub

2.

Código:

Private Function Multiplos(x As Integer) As Integer

    Dim i As Integer, cont As Integer, mult As Integer

    

    cont = 0

    

    For i = 1 To 50

        mult = x * i

        If mult <= 50 Then

            cont = cont + 1

        Else

            Exit For

        End If

    Next i

    Multiplos = cont

End Function

Private Sub Command1_Click()

    Dim num As Integer

    

    Do

        num = Val(InputBox("Introduza um número", "Número"))

        If num <= 0 Then

            MsgBox "O número é inválido", vbCritical, "Aviso"

        End If

    Loop While num <= 0

    

    MsgBox "O número " & num & " tem " & Multiplos(num) & " múltiplos inferiores a 50.", vbInformation, "Resultado"

End Sub

3.

Código:

Private Function SomaN(x As Integer) As Integer

    Dim i As Integer, soma As Integer

    

    soma = 0

    

    For i = 1 To x

        soma = soma + i

    Next i

    

    SomaN = soma

End Function

Private Sub Command1_Click()

    Dim num As Integer

    

    Do

        num = Val(InputBox("Introduza um valor:", "Valor"))

        If num < 0 Then

            MsgBox "O valor introduzido é inválido", vbCritical, "Aviso"

        End If

    Loop While num < 0

    

    MsgBox "A soma dos números é " & SomaN(num), vbInformation, "Resultado"

End Sub

4.

Código:

Private Function Exponencial(x As Integer, y As Integer) As Integer

    Dim i As Integer, res As Integer

    

    res = 1

    

    If y <> 0 Then

        For i = 1 To y

            res = res * x

        Next i

    End If

    

    Exponencial = res

End Function

Private Sub Command1_Click()

    Dim a As Integer, b As Integer

    

    Do

        a = Val(InputBox("Introduza o 1º valor:", "1º valor"))

        b = Val(InputBox("Introduza o 2º valor:", "2º valor"))

        If a <= 0 Or b < 0 Then

            MsgBox "O valor introduzido é inválido", vbCritical, "Aviso"

        End If

    Loop While a <= 0 Or b < 0

    

    MsgBox "O valor de " & a & " elevado a " & b & " é " & Exponencial(a, b), vbInformation, "Resultado"

End Sub