Ir para conteúdo
Fórum Script Brasil

João.Neto

Membros
  • Total de itens

    139
  • Registro em

  • Última visita

Tudo que João.Neto postou

  1. Adicione a referência Microsoft Scripting Runtime Utilize este código: Dim fso As Scripting.FileSystemObject Set fso = new Scripting.FileSystemObject If fso.FileExists("C:\MeuArquivo.xls") Then ... Se o arquivo existir eu executo minhas instruções ... End If
  2. Renato, para adicionar mais de um destinatário, faça como abaixo: contato="fulano@i.com;joaquina@t.com.br" Delimito os destinatários como no Outlook: com ponto-e-vírgula (;). Agora, incluir em cópia, vou verificar e te passo assim que conseguir, beleza?
  3. Para saber o caminho do arquivo atual use ThisWorkbook.Path
  4. João.Neto

    Treeview list

    Web, poste o seu código para nós darmos uma analisada, ok? Mas, antes, dê uma olhada no código abaixo que utilizo para o TreeView onde eu atribuo o ImageList no próprio código e utilizo a propriedade Key, do ImageList, para atribuir a imagem. Private Sub UserForm_Initialize() Dim nodX As Node Set TreeView1.ImageList = ImageList1 Set nodX = TreeView1.Nodes.Add(, , "Root", "Nó Raiz", "fechado") nodX.ExpandedImage = "aberto" nodX.Expanded = True Set nodX = TreeView1.Nodes.Add("Root", tvwChild, "Child1", "Nó Filho 1", "fechado") nodX.ExpandedImage = "aberto" nodX.Expanded = True Set nodX = TreeView1.Nodes.Add("Root", tvwChild, "Child2", "Nó Filho 2", "Arquivo") Set nodX = TreeView1.Nodes.Add("Root", tvwChild, "Child3", "Nó Filho 3", "Arquivo") Set nodX = TreeView1.Nodes.Add("Child1", tvwChild, "Child1A", "Nó Filho 1-A", "Arquivo") Set nodX = TreeView1.Nodes.Add("Child1", tvwChild, "Child1B", "Nó Filho 1-B", "Arquivo") 'Os nomes "fechado", "aberto" e "Arquivo" são os nomes que atribui na propriedade Key da respectiva imagem no controle ImageList. End Sub
  5. Luiz, você pode usar o código abaixo: Option Explicit Private Sub UserForm_Initialize() Dim r As Range For Each r In ThisWorkbook.Worksheets("Plan1").Range("E1:E12").Rows Me.ComboBox1.AddItem Month(r.Cells(1, 1)) Next r End Sub Ou, fazer com que apareça o nome do mês no formato "janeiro", por exemplo: Option Explicit Private Sub UserForm_Initialize() Dim r As Range For Each r In ThisWorkbook.Worksheets("Plan1").Range("E1:E12").Rows Me.ComboBox1.AddItem Format(r.Cells(1, 1),"mmmm") Next r End Sub E para utilizar o valor que for selecionado no combobox, você utiliza, por exemplo: Msgbox ComboBox1.Text beleza? abs B)
  6. Luiz, Eu tenho essa rotina que eu utilizo para criar um menu ao lado do menu Ajuda, o qual me permite abrir meu formulário. Ah, eu o coloco em um módulo de código. Sub AddMenus(ByVal SYS As SISTEMA) Dim cMenu1 As CommandBarControl Dim cbMainMenuBar As CommandBar Dim iHelpMenu As Integer Dim cbcCutomMenu As CommandBarControl On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls("&Sistema BackOffice").Delete On Error GoTo 0 Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar") iHelpMenu = cbMainMenuBar.Controls("Ajuda").Index Set cbcCutomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, Before:=iHelpMenu) cbcCutomMenu.Caption = "&Sistema BackOffice" With cbcCutomMenu.Controls.Add(Type:=msoControlButton) .Caption = "&Reexibir Sistema" .OnAction = "MyMacro1" End With End Sub Sub DeleteMenu() On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls("&Sistema BackOffice").Delete On Error GoTo 0 End Sub Sub MyMacro1() frmBackOffice.Show End Sub E esse código aqui eu coloco no EstaPasta_de_trabalho: Private Sub Workbook_BeforeClose(Cancel As Boolean) DeleteMenu End Sub Private Sub Workbook_Open() AddMenus End Sub
  7. Luiz, Esta rotina que você postou está quase certa. O correto é a rotina abaixo: Dim ctrl As Control For Each ctrl In UserForm1.Controls If TypeName(ctrl) = "OptionButton" Then If ctrl.Value = True Then MsgBox "bla, bla, bla...." End If End If Next ctrl
  8. Marcelo, tente o código abaixo: ThisWorkbook.Worksheets(1).PivotTables("Tabela dinâmica1").SourceData = "Plan1!R1C1:R188C19" Ou, se a tabela dinâmica não estiver na mesma pasta de trabalho de onde a macro está sendo executada: Workbooks("NomeDaPasta.xls").Worksheets(1).PivotTables("Tabela dinâmica1").SourceData = "Plan1!R1C1:R188C19" beleza, meu jovem? B)
  9. João.Neto

    barra de rolagem

    É simples, esta barra fica disponível na barra de ferramentas Caixa de Ferramen. de Controle . Depois de tê-la adicionado à sua planilha, clique com o botão direito sobre ela e depois em Propriedades - lembrando que o Modo Design (ícone do lápis com esquadro) deve estar selecionado. Para linkar o valor selecionado à uma célula, digite a célula na propriedade LinkedCell assim, por exemplo: "A1" (sem as aspas) ou "Base!A1" (sem as aspas). Para determinar o valor máximo, utilize a propriedade Max. Para mudar a orientação (horizontal/vertical) utilize a propriedade Orientation B)
  10. Tente este código: Dim wkb as Workbook For Each wkb In Workbooks If wkb.Name Like "*Informativo Soja e Milho*" Then Workbooks("Informativo Principal").Worksheets("Lista").Range("A1").End(xlup).Offset(1,0) = _ wkb.Worksheets("Sheets onde existe a célula que quero extrair o valor").Range("G24") End If Next Estou considerando que todas as planilhas de informativo já estão abertas... :wacko:
  11. João.Neto

    Dúvida

    No input box, como é digitada a data? Ou seja, quando aparece a caixa para o usuário digitar, é digitado no formato exemplificado abaixo: "29/12/2008" ... Se sim, então basta você fazer as seguintes modificações: ... If Cells(i, 1) = g Then Cells(i, 2) = Workbooks("Informativo do Boi -" & Format(g, "ddmmyy") & ".xls").Worksheets("EDIÇÃO").Cells(45, 18) Cells(i, 3) = Workbooks("Informativo do Boi -" & Format(g, "ddmmyy") & ".xls").Worksheets("EDIÇÃO").Cells(46, 18) Cells(i, 4) = Workbooks("Informativo do Boi -" & Format(g, "ddmmyy") & ".xls").Worksheets("EDIÇÃO").Cells(47, 18) Cells(i, 5) = Workbooks("Informativo do Boi -" & Format(g, "ddmmyy") & ".xls").Worksheets("EDIÇÃO").Cells(48, 18) Cells(i, 6) = Workbooks("Informativo do Boi -" & Format(g, "ddmmyy") & ".xls").Worksheets("EDIÇÃO").Cells(49, 18) Cells(i, 7) = Workbooks("Informativo do Boi -" & Format(g, "ddmmyy") & ".xls").Worksheets("EDIÇÃO").Cells(18, 14) End If :D ...
  12. Cara, existem n maneiras de se fazer isso: Primeiro usando uma variável do tipo Workbook: Dim wkb as Workbook set wkb = Workbooks.Open "c:\meus relatorios\relatorio.xls" ou set wkb = workbooks("Pasta1.xls") Importante: Nunca se esqueça de colocar o ".xls". Você pode usar uma variável do tipo string para guardar o nome da pasta de trabalho: dim nome_pasta as string nome_pasta = Sheets(1).Name & ".xls" workbooks(nome_pasta).activate Importante: Nunca se esqueça de colocar o ".xls", se o nome da sheet não tiver .xls então coloque-o manualmente. :ninja:
  13. q droga... mas cara, manda o print do help para mim q eu tento te ajudar... ou instala o 2003 na sua máquina... você pode ter duas versões do excel no pc...
  14. É só acrescentar esta linha de código no começo: Application.ScreenUpdating = False
  15. Cara, realmente eu não sei o que pode ter ocorrido. Utilizo a versão 2003 do excel e funciona normalmente. Como nunca programei em VBA do 2007 não posso te ajudar...
  16. Adriano, Está meio confusa a sua dúvida, mas vamos lá. Crie uma verificação de qual check box está com o valor definido para True através de uma cadeia de Ifs. Assim Sub botaoenviacalculo_Click() If CheckBox1.Value = True Then Range("A1") = "Texto que eu quero enviar" ElseIf CheckBox1.Value = True Then Range("A1") = "Texto que eu quero enviar" ElseIf CheckBox1.Value = True Then Range("A1") = "Texto que eu quero enviar" ElseIf CheckBox1.Value = True Then Range("A1") = "Texto que eu quero enviar" End If End Sub Espero ter ajudado.
  17. No formato "Pasta de Trabalho do Microsoft Excel 97 - Excel 2003 e 5.0/95", ou melhor, com a extensão ".xls".
  18. Já respondido no tópico http://scriptbrasil.com.br/forum/index.php?showtopic=131417. Por favor, evitar repetição de tópico. Obrigado
  19. Sub preencheComboBox() With Application.FileSearch .LookIn = "F:\Pasta dos Pagadores de Pensão" .FileType = msoFileTypeExcelWorkbooks .Filename = "*.xls" If .Execute() > 0 Then For i = 1 To .FoundFiles.Count ComboBox1.AddItem .FoundFiles(i) Next i Else MsgBox "Não achei nada, não!" End If End With End Sub :ninja:
  20. Ok... sempre que precisar de ajuda... nós os veteranos (21 anos) estaremos disponível para tirar qualquer dúvida e solucionar os problemas... rs... Feliz ano novo tb... rsss. :D
  21. Nossa! que tripa de código, hein ?! rssssss.... Usa o operador Like no lugar do If Assim: ElseIf D1 Like "Z" Then ActiveCell.Offset(0, 12).Select ActiveCell.FormulaR1C1 = "VDN"
  22. É possível sim e sem complicação. Na pasta Clientes, crie um novo módulo e nesse módulo adicione a rotina abaixo: Public Sub SalvaDados(ByVal dado1 As String, ByVal dado2 As String) ThisWorkbook.Worksheets(1).Range("A1") = dado1 ThisWorkbook.Worksheets(1).Range("A2") = dado2 End Sub Depois no botão CB_Transferir adicione o seguinte código: Private Sub CB_Transferir_Click() Workbooks.Open (ThisWorkbook.Path & "\Clientes.xls") Application.Run "'Clientes.xls'!SalvaDados", ThisWorkbook.Worksheets(1).Range("A1"), ThisWorkbook.Worksheets(1).Range("A2") End Sub ok? abs...
  23. Pelo que entendi sqrst é um tipo de dados (String) e não um objeto, logo você não pode utilizar a expressão Set sqrst =. O correto a ser feito é: sqrst = "select " _ & "cliente.código, sum (movimento.val) " _ & "as somadeval, movimento.ref, movimento.cdat " _ & "from cliente inner join movimento on cliente.código = movimento.cod " _ & "group by cliente.código, movimento.ref, movimento.cdat " _ & "having(((cliente.código)=clien) and ((movimento.ref)=2));" Observe que eu acrescentei também um espaço no final de cada linha de texto para que a instrução sql não fique "grudada" gerando outro erro. Espero ter ajudado. abs. :ninja:
  24. Faça com que o código desproteja a planilha, grave os dados do Form e projeta-a novamente.
  25. É possível sim !!! Sub LocalizaArquivo() With Application.FileSearch .LookIn = "F:\" .FileType = msoFileTypeExcelWorkbooks .Filename = "*2008*" If .Execute() > 0 Then For i = 1 To .FoundFiles.Count ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0) = _ .FoundFiles(i) Next i Else MsgBox "Não achei nada, não!" End If End With End Sub B)
×
×
  • Criar Novo...