Ir para conteúdo
Fórum Script Brasil

benzadeus

Membros
  • Total de itens

    84
  • Registro em

  • Última visita

Posts postados por benzadeus

  1. Selecione a coluna que possui o nome das cidades e pressione Ctrl+U para mostrar a janela de substituição.

    Em Localizar, escreva ' (ou seja, apóstrofo)

    Em Substituir por, deixe em branco.

    Clique então em Substituir tudo.

  2. Seria um pouco complicado você usar as ferramentas nativas de tabela dinâmica para obter o efeito que deseja.

    Tenho uma sugestão. Na célula J42, entre com a fórmula:

    ="Acum. " & TEXTO(D42;"mmm-aa")

    Arraste essa fórmula (copie) até a célula N42.

    Na célula J43, entre com a fórmula:

    =SOMA(B43:D43)

    Copie essa fórmula para o intervalo J43:N76.

  3. Private Sub CommandButton1_Click()
        If Not CheckBox1 Then Exit Sub
        
        ActiveDocument.Bookmarks("InserirTexto").Select
        
        Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
        Selection.Font.Bold = True
        Selection.Font.Name = "ARIAL"
        Selection.Font.Italic = True
        Selection.Font.Size = 12
        Selection.TypeText Text:="ESTRADO DE PVC"
        Selection.Font.Bold = False
        Selection.TypeParagraph
        Selection.TypeText Text:="Estrados plásticos, funcional, antiderrapante, higiênico e de fácil colocação. Suporta até 21 tons/m2 de carga estática."
        Selection.TypeParagraph
        Selection.TypeText Text:="Disponível nas cores branca, azul, marrom e cinza; com altura de 25 mm. Placas 500x500mm."
        Selection.TypeParagraph
        Selection.TypeParagraph
    End Sub

  4. Crie um formulário com 5 Rótulos (Labels) chamados:

    lblTexto1

    lblTexto2

    lblTexto3

    lblTexto4

    lblTexto5

    Em seguida, cole o código abaixo na classe do formulário:

    Private Sub UserForm_Initialize()
        Dim ctrl As Control
        Dim sValorTexto(1 To 5)
        Dim lValor As Long
        
        sValorTexto(1) = "Benzadeus"
        sValorTexto(2) = "Teste"
        sValorTexto(3) = "Felipe"
        sValorTexto(4) = "Costa"
        sValorTexto(5) = "Gualberto"
        
        For Each ctrl In Me.Controls
            If Left(ctrl.Name, Len("lblTexto")) = "lblTexto" Then
                lValor = Replace(ctrl.Name, "lblTexto", "")
                ctrl.Caption = sValorTexto(lValor)
            End If
        Next ctrl
    End Sub

  5. Sugiro trocar por:

    Linha = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Fiz uma discussão sobre obter última linha por VBA em: http://www.ambienteoffice.com.br/excel/obt...e_um_intervalo/ Troque também:
    Private Sub fem1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Dim strValid As String
        strValid = "0123456789"
    
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    End Sub
    
    
    Private Sub fem2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Dim strValid As String
        strValid = "0123456789"
    
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    End Sub
    
    Private Sub fem3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Dim strValid As String
        strValid = "0123456789"
    
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    End Sub
    
    Private Sub masc1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Dim strValid As String
        strValid = "0123456789"
    
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    
    End Sub
    
    
    Private Sub masc2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Dim strValid As String
        strValid = "0123456789"
    
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    End Sub
    
    
    Private Sub masc3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Dim strValid As String
        strValid = "0123456789"
    
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    End Sub
    por:
    Private Sub fem1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        KeyAscii = ValidarTecla(KeyAscii)
    End Sub
    
    
    Private Sub fem2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        KeyAscii = ValidarTecla(KeyAscii)
    End Sub
    
    Private Sub fem3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        KeyAscii = ValidarTecla(KeyAscii)
    End Sub
    
    Private Sub masc1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        KeyAscii = ValidarTecla(KeyAscii)
    End Sub
    
    
    Private Sub masc2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        KeyAscii = ValidarTecla(KeyAscii)
    End Sub
    
    
    Private Sub masc3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        KeyAscii = ValidarTecla(KeyAscii)
    End Sub
    
    Private Function ValidarTecla(i As Integer) As Integer
        If InStr("0123456789", Chr(i)) = 0 Then
            MsgBox "Utilize apenas números!", vbCritical
            ValidarTecla = 0
        Else
            ValidarTecla = i
        End If
    End Function

  6. Tente:

    On Error Resume Next
            If omsg.Sent Then
                MsgBox "O email foi enviado!"
            Else
                MsgBox "O email não foi enviado!"
            End If
            On Error GoTo 0

    Explicação: tentar acessar omsg.Sent retorna um erro quando o e-mail foi enviado, por isso a necessidade de usar On Error Resume Next. No entanto, se a caixa do Display for cancelada, omsg.Sent retorna Falso.

  7. Outra alternativa é você deixar muitas linhas extras e adicionar a macro abaixo no evento abaixo:

    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        With Sheets("sua_planilha")
            If ActiveSheet.Name = .Name Then
                .PageSetup.PrintArea = .UsedRange.Address
            End If
        End With
    End Sub

    Dessa forma, toda vez que um usuário dá o comando de imprimir, a área de impressão é redimensionada para o intervalo retangular que a Planilha está efetivamente preenchida.

  8. Essa classificação de dados se aplicará na coluna C de uma tabela que está preenchida da célula B16 a C500. Além disso, essa Planilha deve ser a primeira (índice 1) da sua Pasta de Trabalho, isto é, deve estar na primeira aba. Você está atendendo esses requisitos antes de executar essa rotina?

×
×
  • Criar Novo...