1
resposta

Duvida e projeto

Não sei se é o momento para sanar essa duvida, mas vamos lá!

Quando eu fiz meu if (If resultado = vbYes Then) bem no comecinho do código, deu certo e quando testo a opção para renomear eu consigo renomear. Porém, se eu utilizar primeiro a opção não (renomeia sozinho) e depois utilizo a opção sim(para acionar o prompt e eu mesmo renomear) acaba dando erro. Qual o problema desse script?

Option Explicit

Sub arrumarSheets()
    
    Dim resultado As Long
    Dim varNameNewSheets As Long
    Dim varLinha As Long
    
    resultado = MsgBox("Você deseja escolher o nome do arquivo? ", vbYesNo, "Renomeando...")
    
    If resultado = vbYes Then
        ActiveSheet.Copy After:=Sheets(1)
        varNameNewSheets = InputBox("Digite o nome da nova planilha:")
        ActiveSheet.Name = varNameNewSheets
    Else
        ActiveSheet.Copy After:=Sheets(1)
        ActiveSheet.Name = "Formatado em " & Format(Now, "HH-mm-ss")
    End If
    
    varLinha = 2
    
    Do While Trim(Cells(varLinha, 1)) <> ""
    
        ' Coluna A
        If Left(Cells(varLinha, 1), 5) <> "byte_" Then
            Cells(varLinha, 1) = "byte_" & Cells(varLinha, 1)
        End If
        
        ' Coluna B
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "*", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "#", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "$", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "%", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "@", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "&", "")
        
        'Coluna C
        Cells(varLinha, 3) = Replace(Cells(varLinha, 3), "R$", "")
        Cells(varLinha, 3) = Replace(Cells(varLinha, 3), ",", "")
        Cells(varLinha, 3) = Replace(Cells(varLinha, 3), ".", ",")
        Cells(varLinha, 3).NumberFormat = "_-[$R$-pt-BR] * #,##0.00_-;-[$R$-pt-BR] * #,##0.00_-;_-[$R$-pt-BR] * ""-""??_-;_-@_-"
        
        'Coluna D
        Cells(varLinha, 4) = Replace(Cells(varLinha, 1), "byte_", "") & "@bytebank.com"
        
        'Incremento
        varLinha = varLinha + 1
    Loop
    
    
    'Colorir planilha
    Range("A1:D10").Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$D$10"), , xlYes).Name = _
        "Tabela1"
    
    
    
    'Identação
    Range("Tabela1[#All]").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

End Sub
1 resposta

Olá Lucas, tudo bem com você?

Ao executar sua macro obtive o erro Tipos Incompatíveis e também Erro de definição de aplicativo ou de definição de objeto. Isso ocorre em primeiro momento devido aos tipos das variáveis que armazenam String e Integer respectivamente, mas no seu código está como Long.

Código Corrigido:

 Dim varNameNewSheets As String
 Dim varLinha As Integer

Em segundo momento quando ocorre o erro de definição de aplicativo ou de definição de objeto é devido a forma como você está selecionando os intervalos antes de utilizar o Range, onde deve-se declarar que está querendo obter o intervalo da planilha ativa.

Exemplo do código corrigido:

ActiveSheet.Range("$A$1:$D$10").Select

A seguir o código com todas as correções:

Option Explicit

Sub arrumarSheets()
    
    Dim resultado As Long
    Dim varNameNewSheets As String
    Dim varLinha As Integer
    
    resultado = MsgBox("Você deseja escolher o nome do arquivo? ", vbYesNo, "Renomeando...")
    
    If resultado = vbYes Then
        ActiveSheet.Copy After:=Sheets(1)
        varNameNewSheets = InputBox("Digite o nome da nova planilha:")
        ActiveSheet.Name = varNameNewSheets
    Else
        ActiveSheet.Copy After:=Sheets(1)
        ActiveSheet.Name = "Formatado em " & Format(Now, "HH-mm-ss")
    End If
    
    varLinha = 2
    
    Do While Trim(Cells(varLinha, 1)) <> ""
    
        ' Coluna A
        If Left(Cells(varLinha, 1), 5) <> "byte_" Then
            Cells(varLinha, 1) = "byte_" & Cells(varLinha, 1)
        End If
        
        ' Coluna B
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "*", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "#", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "$", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "%", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "@", "")
        Cells(varLinha, 2) = Replace(Cells(varLinha, 2), "&", "")
        
        'Coluna C
        Cells(varLinha, 3) = Replace(Cells(varLinha, 3), "R$", "")
        Cells(varLinha, 3) = Replace(Cells(varLinha, 3), ",", "")
        Cells(varLinha, 3) = Replace(Cells(varLinha, 3), ".", ",")
        Cells(varLinha, 3).NumberFormat = "_-[$R$-pt-BR] * #,##0.00_-;-[$R$-pt-BR] * #,##0.00_-;_-[$R$-pt-BR] * ""-""??_-;_-@_-"
        
        'Coluna D
        Cells(varLinha, 4) = Replace(Cells(varLinha, 1), "byte_", "") & "@bytebank.com"
        
        'Incremento
        varLinha = varLinha + 1
    Loop
    
    ' Verificar se a tabela existe e removê-la se necessário
    On Error Resume Next
        ActiveSheet.ListObjects("Tabela1").Delete
    On Error GoTo 0
    
    ' Adicionar tabela
    ActiveSheet.Range("A1:D10").ClearContents  ' Limpar intervalo se existir
    
    
    'Colorir planilha
    ActiveSheet.Range("A1:D10").Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.Range("$A$1:$D$10"), , xlYes).Name = _
        "Tabela1"
    
    
    
    'Identação
    ActiveSheet.Range("$A$1:$D$10").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With


End Sub

Além disso, uma dica de boas práticas é criar uma sub-rotina separada para adicionar a tabela, especialmente se você planeja utilizar essa funcionalidade em diferentes partes do seu código ou se deseja manter uma estrutura mais modular e fácil entendimento.

Espero ter ajudado. Continue mergulhando em conhecimento e não hesite em voltar ao fórum para continuar aprendendo e interagindo com a comunidade. Em caso de dúvidas estou à disposição.

Abraços e bons estudos!

Caso este post tenha lhe ajudado, por favor, marcar como solucionado ✓. Bons Estudos!