Este fórum foi descontinuado. LEIA AQUI e participe da Comunidade BABOO :)

Ir para conteúdo
jj_cwb

Código VBA - Excel

Mensagem Recomendada

Olá pessoal,

Criei uma macro que ao ser executada abre uma InputBox solicitando o nome da nova planilha e após a nomeia com este nome. O porém é que sempre que digito mais de uma vez um nome já existente dá erro, a mensagem que aparece é: "Erro em tempo de execução ''1004''" Tentei localizar de todas as formas o erro mas infelizmente não consegui encontrá-lo. Quem puder ajudar-me agradeço desde já! Segue abaixo as linhas de códig

Sub insereplanilha()

On Error GoTo ErrNumber

Dim nome As String

Set Planilha = ActiveWorkbook.Worksheets.Add(, After:=Worksheets(Worksheets.Count))

EntrarNomePlanilha: nome = InputBox("Digite o nome da nova planilha na caixa abaixo!", "Nome da Planilha")

If nome = "" Then

MsgBox "Você precisa entrar com o nome da planilha antes de continuar!", vbCritical, "Nome"

GoTo EntrarNomePlanilha

End If

Planilha.Name = nome

ActiveWindow.DisplayGridlines = False

Exit Sub

ErrNumber:

If Err.Number = 1004 Then

MsgBox "Uma planilha com este nome já existe. Tente novamente!", vbCritical, "Nome existente"

GoTo EntrarNomePlanilha

End If

End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

fiz duas opções...

1) alterei seu código para verificar se a planilha já existe...

2) retirei o goto... fica com um código melhor...

 

 9.gif UCASE: converte todas as letras para maiusculas... ou seja, "Plan1" e "plan1" são iguais...

Sub insereplanilha()

Dim Existe As Boolean

Dim nome As String

  Set Planilha = ActiveWorkbook.Worksheets.Add(, After:=Worksheets(Worksheets.Count))

 

EntrarNomePlanilha:

  nome = InputBox("Digite o nome da nova planilha na caixa abaixo!", "Nome da Planilha")

 

  Existe = False

  For i = 1 To Worksheets.Count

  If UCase(nome) = UCase(Worksheets ( i ).Name) Then

  Existe = True

  Exit For

  End If

  Next i

 

  If (nome = "") Then

  MsgBox "Você precisa entrar com o nome da planilha antes de continuar!", vbCritical, "Nome"

  GoTo EntrarNomePlanilha

  ElseIf Existe Then

  MsgBox "A planilha já existe!" + vbCrLf + "Você precisa entrar com o nome da planilha antes de continuar!", vbCritical, "Planilha existente!"

  GoTo EntrarNomePlanilha

  End If

 

  Planilha.Name = nome

  ActiveWindow.DisplayGridlines = False

End Sub

Sub insereplanilha2()

Dim Existe As Boolean

Dim nome As String

  Set Planilha = ActiveWorkbook.Worksheets.Add(, After:=Worksheets(Worksheets.Count))

 

  nome = ""

  While nome = "" Or Existe

 

  nome = InputBox("Digite o nome da nova planilha na caixa abaixo!", "Nome da Planilha")

 

  Existe = False

  For i = 1 To Worksheets.Count

  If UCase(nome) = UCase(Worksheets ( i ).Name) Then

  Existe = True

  Exit For

  End If

  Next i

 

  If (nome = "") Then

  MsgBox "Você precisa entrar com o nome da planilha antes de continuar!", vbCritical, "Nome"

  ElseIf Existe Then

  MsgBox "A planilha já existe!" + vbCrLf + "Você precisa entrar com o nome da planilha antes de continuar!", vbCritical, "Planilha existente!"

  End If

  Wend

 

  Planilha.Name = nome

  ActiveWindow.DisplayGridlines = False

End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

Pessoal sou novo aqui, pesquisando no google sobre vba achei esse topico. Estou com um codigo em VBA e nao estou conseguindo resolver aquele probleminha da incompatibilidade do vba em 32 para 64 bits, ja tentei resolver usando o ptrsafe mas nao devo estar declarando ele de forma correta, abaixo segue meu codigo do vba completo se alguma boa alma puder me ajudar fico eternamente agradecido.

-------------------------------------------------------------

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long

Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_THICKFRAME As Long = &H40000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_POPUP As Long = &H80000000
Private Const WS_VISIBLE As Long = &H10000000

Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const WS_EX_TOOLWINDOW As Long = &H80

Private Const SC_CLOSE As Long = &HF060

Private Const SW_HIDE As Long = 0
Private Const SW_SHOW As Long = 5

Private Const WM_SETICON = &H80

Dim hWndForm As Long, mbSizeable As Boolean, mbCaption As Boolean, mbIcon As Boolean, miModal As Integer
Dim mbMaximize As Boolean, mbMinimize As Boolean, mbSysMenu As Boolean, mbCloseBtn As Boolean
Dim mbAppWindow As Boolean, mbToolWindow As Boolean, msIconPath As String
Dim moForm As Object
Public Property Let Modal(bModal As Boolean)
    miModal = Abs(CInt(Not bModal))

    'Make the form modal or modeless by enabling/disabling Excel itself
    EnableWindow FindWindow("XLMAIN", Application.Caption), miModal
End Property

Public Property Get Modal() As Boolean
    Modal = (miModal <> 1)
End Property

Public Property Set Form(oForm As Object)

    If Val(Application.Version) < 9 Then
        hWndForm = FindWindow("ThunderXFrame", oForm.Caption)  'XL97
    Else
        hWndForm = FindWindow("ThunderDFrame", oForm.Caption)  'XL2000
    End If

    Set moForm = oForm

    AtualizarEstiloForm

    AtualizarIcone
    
End Property

Private Sub AtualizarEstiloForm()

    Dim iStyle As Long, hMenu As Long, hID As Long, iItems As Integer

    If hWndForm = 0 Then Exit Sub

    iStyle = GetWindowLong(hWndForm, GWL_STYLE)

    iStyle = iStyle Or WS_CAPTION
    iStyle = iStyle Or WS_SYSMENU
    iStyle = iStyle Or WS_THICKFRAME
    iStyle = iStyle Or WS_MINIMIZEBOX
    iStyle = iStyle Or WS_MAXIMIZEBOX
    iStyle = iStyle And Not WS_VISIBLE And Not WS_POPUP

    SetWindowLong hWndForm, GWL_STYLE, iStyle

    iStyle = GetWindowLong(hWndForm, GWL_EXSTYLE)

    iStyle = iStyle And Not WS_EX_DLGMODALFRAME
    iStyle = iStyle Or WS_EX_APPWINDOW

    SetWindowLong hWndForm, GWL_EXSTYLE, iStyle

    hMenu = GetSystemMenu(hWndForm, 0)
    
    ShowWindow hWndForm, SW_SHOW
    DrawMenuBar hWndForm
    SetFocus hWndForm

End Sub

Private Sub AtualizarIcone()

    Dim hIcon As Long

    On Error Resume Next
    
    If hWndForm <> 0 Then

    msIconPath = "\\santavitoria.intra\Storage\Users\dfsq\My Documents\My Pictures\home.ico"  'Coloque aquí o seu ícone
        Err.Clear
        If msIconPath = "" Then
            hIcon = 0
        ElseIf Dir(msIconPath) = "" Then
            hIcon = 0
        ElseIf Err.Number <> 0 Then
            hIcon = 0
        ElseIf Not mbIcon Then
            hIcon = ExtractIcon(0, msIconPath, 0)
        Else
            hIcon = 0
        End If

        SendMessage hWndForm, WM_SETICON, True, hIcon
    End If

End Sub
 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Compartilhar este post


Link para o post
Compartilhar em outros sites
14 horas atrás, osvaldomp disse:

Velho muito obrigado pela atenção e presteza mas essa resolução eu já havia encontrado o que nao estou conseguindo é saber onde inserir o codigo, acho que nao estou sabendo declarar elas ou entao estou colocando em local errado dentro do codigo, as vezes alguém ja teve esse mesmo problema e consegue me orientar melhor =/ ....

Compartilhar este post


Link para o post
Compartilhar em outros sites

Sugiro que você disponibilize uma amostra do seu arquivo com todos os seus códigos instalados, assim talvez facilite para você obter ajuda.


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

×
×
  • Criar Novo...