Ir para conteúdo
Fórum Script Brasil

benzadeus

Membros
  • Total de itens

    84
  • Registro em

  • Última visita

Tudo que benzadeus postou

  1. Desculpe a demora. Acredito que sua macro esteja funcionando somente uma vez porque toda vez que você usa o método Select para selecionar a Planilha resolvidas, o evento Worksheet_Change dela é executado e bloqueando-a: Private Sub Worksheet_Activate() protege End Sub Para evitar que essa rotina rode, altere a propriedade EnableEvents do objeto Application para falso, e restaure novamente seu estado ao término da execução da rotina. Um exemplo pode ser visto abaixo: Private Sub Exemplo() Dim lLast As Long Dim rng As Range If ActiveSheet.Name = "Controle" Then Application.EnableEvents = False With Sheets("resolvidas") 'Atenção: aqui deve ter um código para desbloquear a Planilha resolvidas Set rng = Cells(ActiveCell.Row, 1) lLast = .Cells(.Rows.Count, "A").End(xlUp).Row rng.Range("A1:AM1").Cut _ Destination:=.Cells(lLast + 1, "A").Range("B1:AM1") 'Aqui vai o código para bloquear novamente a Planilha resolvidas End With Application.EnableEvents = True End If End Sub
  2. A Pasta de Trabalho é muito grande. A operação dessa macro copia dados de qual Planilha para qual?
  3. Se a resposta abaixo não resolver seu problema, favor disponibilizar sua Pasta de Trabalho para download: Sub Teste() Application.EnableEvents = False Range("A1:AM1").Copy Destination:=Sheets("resolvidas").Range("A3") Sheets("resolvidas").Unprotect "12312" Sheets("resolvidas").End(xlDown).Offset(1, 0).Paste Range("S1:AM1").ClearContents Sheets("resolvidas").Protect "12312" Application.EnableEvents = True End Sub
  4. Veja um exemplo pronto em: https://skydrive.live.com/redir?resid=FB206...10E0661!403 O código usado foi: Sub Exemplo() Dim l As Long Dim lPopulação As Long Dim wsEstados As Worksheet Dim wsPopulação As Worksheet Dim rng As Range Set wsEstados = ThisWorkbook.Sheets("Estados") Set wsPopulação = ThisWorkbook.Sheets("População") 'Considerando uma linha de cabeçalho: For l = 2 To RowLast(wsEstados.Columns("A")) Set rng = wsEstados.Cells(l, "A") If Not rng.Comment Is Nothing Then rng.Comment.Delete lPopulação = EleOf(rng, wsPopulação.Columns("A")) If lPopulação > 0 Then rng.AddComment Text:="População: " & Format(wsPopulação.Cells(lPopulação, "B"), "0,00#") Else rng.AddComment "Não foi localizada uma correspondência!" End If Next l End Sub Sub ApagarComentários() 'Apenas se desejar apagar todos os comentários de uma Planilha Dim cmt As Comment For Each cmt In ActiveSheet.Comments cmt.Delete Next cmt End Sub Function RowLast(rng As Range) As Long 'Retorna o valor da última linha povoada do intervalo rng With rng On Error Resume Next RowLast = .Find(What:="*" _ , After:=.Cells(1) _ , SearchDirection:=xlPrevious _ , SearchOrder:=xlByColumns _ , LookIn:=xlFormulas).Row If RowLast = 0 Then RowLast = rng.Cells(1).Row End With End Function Function EleOf(ByVal vTermo As Variant, ByVal vVetor As Variant) As Long 'Retorna o número da linha ou coluna de uma célula numa linha ou coluna. 'Se vVetor for uma Variant(), retorna o índice do elemento no vetor. 'Caso não seja encontrada nenhuma ocorrência, é retornado 0. On Error Resume Next Select Case TypeName(vVetor) Case "Range" If vVetor.Columns.Count = 1 Then 'vVetor é uma coluna EleOf = WorksheetFunction.Match(vTermo, vVetor, 0) + vVetor.Row - 1 ElseIf vVetor.Rows.Count = 1 Then 'vVetor é uma linha EleOf = WorksheetFunction.Match(vTermo, vVetor, 0) + vVetor.Column - 1 End If Case "Variant()" EleOf = WorksheetFunction.Match(vTermo, vVetor, 0) End Select End Function
  5. Por que não apagar as linhas extras antes de imprimir o arquivo? Ou melhor, limitar a área de impressão antes de imprimir?
  6. Sub Exemplo() Dim b As Boolean Dim rng As Range Set rng = Range("A3") b = EstáVisível(rng) If b Then MsgBox "A célula " & rng.Address(0, 0) & " está visível na janela ativa." _ , vbInformation Else MsgBox "A célula " & rng.Address(0, 0) & " não está visível na janela ativa." _ , vbInformation End If End Sub Function EstáVisível(rng As Range) As Boolean EstáVisível = Not Intersect(rng, ActiveWindow.VisibleRange) Is Nothing End Function
  7. Versão em português, que terminei de desenvolver: http://www.ambienteoffice.com.br/suplementos/emailxl/
  8. benzadeus

    Variável "Variando"

    Dim l As Long For l = 1 To 3 Me.Controls("OptionButton" & l).Enabled = True Next l
  9. Troque: Result = bus(0).Value text_result = Result por: Do While Not bus.EOF Result = Result & bus.Fields(0) rs.MoveNext 'Vai para próximo resultado Loop text_result = Result
  10. Não entendi muito bem sua pergunta, mas veja se o exemplo:. O código abaixo copia as linhas 5 até 10 para a linha 20 (até 25). Sub Exemplo() Rows("5:10").Copy Destination:=Rows(20) End Sub .
  11. Você está obtendo erro porque está chamando o formulário PF antes de ele ter terminado de executar sua rotina. O Unload Me omite o formulário e zera suas variáveis, mas o código continua em execução aguardando o formulário formPF fechar para executar a próxima linha, que é End Sub. Experimente usar formPF.Show vbModeless Dessa forma, o código não interrompe e continua rodando, e pode ser que esse erro seja contornado.
  12. Falha minha. Experimente trocar ActiveCell.Range("A1:AM1").Copy Destination:=Sheets("resolvidas").Range("A3").Select por ActiveCell.Range("A1:AM1").Copy Destination:=Sheets("resolvidas").Range("A3")
  13. Isso é bastante esquisito. No entanto, substitua todo esse código: #If VBA7 And Win64 Then Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long #Else Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long #End If por: Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long
  14. Não é possível controlar o FireFox por VBA dessa forma. Você pode tentar ler as instruções da página http://www.iol.ie/~locka/mozilla/control.htm Ela possui as instruções de como usar o FireFox como um controle ActiveX, mas não recomendo já que: Visual Basic 6 The Mozilla Browser control should be usable from any automation control container. This includes Visual Basic, so follow these steps to add the control to your VB project: Install the control / or compile it and ensure it is registered. Right mouse over the VB control bar and select "Components...". Choose "MozillaControl 1.0 Type Library" from the list of controls The Mozilla Browser control should now appear in the toolbar for insertion into any application Once the control is inserted, you should be able to directly call the events, methods and properties it exposes. The latest control source contains an example VB project called VBrowse. Note: Save your project often! Bugs in the alpha-quality Mozilla will crash your development environment and will wipe out any unsaved work you may have.
  15. Acho que está errado. O código deveria ser: Sub Somar() contador = ultLinha + 1 soma2 = WorksheetFunction.Sum(Workbooks(relatorio).Sheets("1").Columns("B")) idf = soma2 / contador End Sub
  16. Crie um comentário para as células dos estados com sua respectiva população, esse é o caminho certo.
  17. Baixe o suplemento em: http://www.rondebruin.nl/mail/add-in.htm *Estou fazendo um Suplemento sobre e-mails do Excel baseado nesse do Ron de Bruin. Nesse fim de semana deve ficar pronta a primeira versão, e abrirei o código.
  18. Olá, Tenho impressão que respondi essa pergunta já. Você postou em outro fórum também? Acho que te indiquei minha página para você testar meu Suplemento em seu desenho: http://www.ambienteoffice.com.br/suplementos/cadxl/
  19. benzadeus

    VBA Excel

    Não entendi muito bem o que deseja, mas acho que, em outras palavras, você deseja extrair uma sequência numérica de uma sequência alfanumérica, certo? Veja: http://www.ambienteoffice.com.br/excel/ext...o_alfanumerica/
  20. benzadeus

    Botões de navegação

    Criei um modelo para você adaptar às suas necessidades: https://skydrive.live.com/redir?resid=FB206...10E0661!387
  21. O código deve ficar na classe da Pasta de Trabalho, e não na classe de uma Planilha Certo.
  22. O código abaixo funcionará apenas se as macros estiverem ativados. Deve ser colado na classe EstaPasta_de_trabalho. Crie uma Planilha na Pasta de Trabalho chamada Início, que será a Planilha que usuários não autorizados a acessar outras Planilhas serão redirecionados. Public sUsuário As String Public sComputador As String #If VBA7 And Win64 Then Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long #Else Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _ ByVal lpBuffer As String, nSize As Long) As Long #End If Private Sub Workbook_Open() Dim l As Long Dim s As String 'Obtém Nome do Usuário l = 255 s = String(l, vbNullChar) l = GetUserName(s, l) sUsuário = PorçãoNãoNula(s) '*** OPCIONAL *** 'Obtém Nome do Computador l = 255 s = String(l, vbNullChar) l = GetComputerName(s, l) sComputador = PorçãoNãoNula(s) MsgBox "O usuário atual é " & sUsuário, vbInformation MsgBox "O computador atual é " & sComputador, vbInformation End Sub Private Function PorçãoNãoNula(s As String) As String 'Mostra a porção de uma string à esquerda de 'caracteres nulos (vbNullString e Chr(0). Dim n As Long n = InStr(1, s, vbNullChar) If n = 0 Then PorçãoNãoNula = s Else PorçãoNãoNula = Left(s, n - 1) End If End Function Private Sub Workbook_SheetActivate(ByVal Sh As Object) If Sh.Name <> "Início" Then If Sh.Name <> sUsuário Then MsgBox "Prezado(a) '" & sUsuário & "'," & vbNewLine & _ "Você não tem autorização para acessar esta Planilha." _ , vbCritical Sheets("Início").Select Sheets("Início").Activate End If End If End Sub
×
×
  • Criar Novo...