Search the Community

Boas pessoal, estou a desenvolver um projeto em VB e estou a usar uma base de dados Access. No meu projeto preciso de utilizar imagens e para fazer o 'upload' delas estou a copiar a foto selecionada para a pasta do projeto, usando o código: Application.StartupPath, para que, em qualquer PC que o programa seja usado, a foto seja sempre 'carregada' para a mesma pasta (no meu caso as fotos estão a ser carregadas para a pasta imagens, que criei dentro da pasta dados, que criei dentro da pasta debug, ou seja: Debug/Dados/Imagens. Até aqui tudo bem, o problema agora é na base de dados, pois no campo relativo às fotos fica sempre registado todo o diretório onde a imagem está, assim sendo ao utilizar outro PC, o diretório que está na base de dados deixa de funcionar, pois o caminho já não vai ser igual, pelo menos vai mudar o nome do user. Queria saber se há alguma forma de talvez usar um diretório relativo na base de dados que comessasse no local onde ela está (que no meu caso está localizada na pasta Debug, dentro da pasta Dados, ou seja Debug/Dados). Se não for possível, certamente há aqui alguém que saiba alguma outra maneira de fazer isto funcionar! Agradecia a vossa ajuda!!

Olá! Pretendo que ao colar um valor na célula A2 a célula A3 assuma a data do sistema, e assim sucessivamente ao longo de todas as duas colunas. Ao tentar colocar este pequeno código numa folha de Excel: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 2 Then Cells(Target.Row, 2) = Data End If End Sub Surge-me sempre o erro de: Run-Time Error -2147417848 (80010108) Uma das soluções indicadas que descobri é o "congelar/fixar" umas linhas, mas não resultou. Obrigado desde já. (URL Imagem/erro:https://www.dropbox.com/s/nsklvqw1yuekg19/autodate_error.jpeg?dl=0 )

No Excel faço uma conexão SQL em uma pasta de trabalho com outra pasta de trabalho, conforme código abaixo. Antes verifico se o arquivo existe ou se está aberto em rede. Minha pergunta é: como e onde utilizo as propriedades ConnectionTimeout e CommandTimeout? Se a conexão cair antes do tempo, como faço para verificar e onde insiro a verificação? E se preciso verificar, antes de abrir a conexão, se a mesma está em aberto, pois outras pastas de trabalho também retornam via SQL os dados da mesma pasta de trabalho de origem: fiquei na dúvida se a conexão para os dados de origem é exclusiva da minha pasta de trabalho, ou se dá erro se outra pasta de trabalho também abriu ao mesmo tempo uma conexão com o mesmo arquivo de origem. Obs.: o retorno de dados está funcionando perfeitamente. 'RETORNA OS DADOS 'Instrução SQL stSQL = "Select * From [" & stNomePLan & "$]" stSQL = stSQL & "Where " & stNomeColOrigem & " =" & lgCodAlugueis stSQL = stSQL & "And Data Between #" & Format(dtDataInicio, "MM/DD/YYYY") & "#" stSQL = stSQL & "And #" & Format(dtDataFinal, "MM/DD/YYYY") & "#" 'Cria a conexão Call EstabeleceConexao 'Abre a conexão On Error Resume Next grsConsulta.Open stSQL, gcnConexaoPlan, adOpenKeyset, adLockOptimistic 'gcnConexaoPlan.CommandTimeout 30 'Verifica se houve erro If Err.Number <> 0 Then MsgBox "ERRO!" On Error GoTo 0 GoTo EncerraMacro End If On Error GoTo 0 'Verifica se tem registros na planilha de origem If grsConsulta.RecordCount = 0 Then MsgBox "Operação cancelada! Não há dados a retornar!", vbCritical + vbOKOnly, "ERRO!" GoTo EncerraMacro End If 'Limpa a planilha PlanLíquida gwsPlanLiquida.Cells.Clear 'Insere os títulos das colunas For lgCols = 0 To grsConsulta.Fields.Count - 1 gwsPlanLiquida.Cells(1, lgCols + 1).Value = grsConsulta.Fields(lgCols).Name Next lgCols 'Insere os registros gwsPlanLiquida.Range("A2").CopyFromRecordset grsConsulta 'Acerta a largura das colunas gwsPlanLiquida.Columns.AutoFit lgUltCol = gwsPlanLiquida.Cells(1, Columns.Count).End(xlToLeft).Column If lgUltCol > 1 Then For lgLoopCol = 1 To lgUltCol With gwsPlanLiquida .Columns(lgLoopCol).ColumnWidth = .Columns(lgLoopCol).ColumnWidth + 2 End With Next lgLoopCol End If 'Mensagem de encerramento MsgBox "Operação concluída com sucesso!", vbInformation + vbOKOnly, "OK" Em outro módulo: Public gcnConexaoPlan As ADODB.Connection 'Variável de conexão Public grsConsulta As ADODB.Recordset 'Variável de Recordset Public gstNomeCaminho As String Public gstNomeArquivo As String Sub EstabeleceConexao() Set gcnConexaoPlan = New ADODB.Connection Set grsConsulta = New ADODB.Recordset With gwsApoio gstNomeCaminho = .Range("B5").Value gstNomeArquivo = .Range("B4").Value End With With gcnConexaoPlan .Provider = "Microsoft.ACE.OLEDB.12.0" .ConnectionString = "Data Source=" & gstNomeCaminho & Application.PathSeparator & gstNomeArquivo & _ ";Extended Properties=Excel 12.0" .Open End With End Sub Sub EncerraConexao() gstNomeCaminho = "" gstNomeArquivo = "" If Not (grsConsulta Is Nothing) Then If (grsConsulta.State And adStateOpen) = adStateOpen Then grsConsulta.Close Set grsConsulta = Nothing End If If Not (gcnConexaoPlan Is Nothing) Then If (gcnConexaoPlan.State And adStateOpen) = adStateOpen Then gcnConexaoPlan.Close Set gcnConexaoPlan = Nothing End If End Sub

Ola, alguém me poderia ajudar estou a passar um programa de visual Basic 2019 para Visual Basic 2010 Criei uma class e coloquei la dentro um modulo e está me a dar erro no seguinte codigo: Dim bs As New BindingSource bs.DataSource = dtFATURA bs.Filter = "ID_ENTREGA =" & FATURA xlivro.Range("B5").Value = FATURA xlivro.Range("B6").Value = DATA xlivro.Range("B8").Value = CLIENTE xlivro.Range("B7").Value = MORADA For Each view As DataRowView In bs Dim row = view.Row CODIGO = row("CODIGO") PRODUTO = row("PRODUTO") QUANTIDADE = row("QUANTIDADE") PESO = row("PESO") TOTAL = row("TOTAL") xlivro.Range("A" & RANGO).Value = CODIGO xlivro.Range("B" & RANGO).Value = PRODUTO xlivro.Range("C" & RANGO).Value = QUANTIDADE xlivro.Range("D" & RANGO).Value = PESO xlivro.Range("E" & RANGO).Value = TOTAL xlivro.Range("F" & RANGO).Value = QUANTIDADE * TOTAL TotalFacturado = TotalFacturado + (QUANTIDADE * TOTAL) RANGO += 1 Next No "for Each view as DataRowView In bs " Da o seguinte erro "Error 1 Expression is of type 'Reportes.BindingSource', which is not a collection type."

Boa noite, Tenho ficheiros Excel com macros que acedem a ficheiros DBF para obter informação. Para isso utilizo o OLEDB do Visual Fox Pro. Mas não funciona nas versões 64 bits. E ainda não arranjei solução. Alguém sabe como posso, a partir de um Excel, ligar a ficheiros DBF em 64 bits?

Caros Colegas, Desde já parabéns pelo vosso excelente forum. Preciso de uma ajuda de excel se for possível sff. - Tenho um Excel que tem uma Lista de Nomes + 12 Células com Números, do lado direito tem mais uma tabela com os números que saem por semana. https://ibb.co/7gvn5Nv 1º A Ideia aqui, era, sempre que eu introduzisse na tabela direita determinados números, a tabela do lado esquerdo vai ficando colorida se em cada linha tiver o número correspondente. 2º Numa coluna ao lado dos 12 Número chamada "Contagem", ter a contagem das células que estão a cor, ou seja, se essa linha acertar em 2 / 3 /4 numeros etc da tabela do lado direito, com a primeira função como já está colorida, esta célula vai dizer a quantidade de "acertos" que tem em cada linha, quando chegasse aos 12 Número ficava com algo do tipo "GANHOU" ou algo do gênero. Já tentei diversos tutoriais que encontrei na WEB mas a questão da cor da sempre problemas. Agradeço a vossa ajuda. Obrigado

Bom dia! Pessoal, preciso de ajudar nesse formato de carregamento. as linha 11, 12 e 13 preciso que seja no formato de número, porem está carregando como texto o que impede de formulas, alguém consegue ajudar? .Cells(linha, 1) = Format(Sheets(I).Cells(Lin, 1), "DD/MM/YYYY") .Cells(linha, 2) = Sheets(I).Cells(Lin, 2) .Cells(linha, 3) = Sheets(I).Cells(Lin, 3) .Cells(linha, 4) = Sheets(I).Cells(Lin, 4) .Cells(linha, 5) = Sheets(I).Cells(Lin, 5) .Cells(linha, 6) = Sheets(I).Cells(Lin, 6) .Cells(linha, 7) = Sheets(I).Cells(Lin, 7) .Cells(linha, 😎 = Sheets(I).Cells(Lin, 😎 .Cells(linha, 9) = Sheets(I).Cells(Lin, 9) .Cells(linha, 10) = Sheets(I).Cells(Lin, 10) .Cells(linha, 11) = Format(Sheets(I).Cells(Lin, 11), "#,##0.00") .Cells(linha, 12) = Format(Sheets(I).Cells(Lin, 12), "#,##0.00") .Cells(linha, 13) = Format(Sheets(I).Cells(Lin, 13), "#,##0.00") .Cells(linha, 14) = Sheets(I).Cells(Lin, 14) .Cells(linha, 15) = Sheets(I).Cells(Lin, 15) .Cells(linha, 16) = Sheets(I).Cells(Lin, 16) Fico no aguardo e agradeço. Rubenaldo

fala galera sou novo aqui , nao entendo muito sobre o VBA no exel mas estou com um problema nao cosigo fazer o msgbox da minha planilha disparar quando um valor de uma celula é maior do que a outra parametros Sub alerta() If Range("T3").Value >= Range("N3").Value Then MsgBox "mensagem de teste", vbExclamation, "ALERTA" Else End If End Sub mas ela nao executa, e nem menos dispara quando o valor da celula T3 é maior ou igual ao valor da celula N3 me ajudem por gentileza, nao consegui resolver esse problema

Bom dia, Estou a tentar criar um botão num documento do Word, que me possibilite enviar esse mesmo documento como anexo através do Outlook. Tenho conseguido indicar o assunto, remetente e destinatário através de um código que tenho utilizado, mas não consigo anexar o documento Word. Tenho até conseguido colocar no corpo da mensagem o conteúdo do ficheiro, mas o que pretendo mesmo é que o ficheiro Word seja remetido em anexo. Agradeço a vossa ajuda Private Sub CommandButton1_Click() Dim Email_Assunto As String Dim Email_Enviado_De As String Dim Email_Enviado_Para As String Dim Email_Cc As String Dim Email_Bcc As String Dim Email_Corpo As String Dim Email_Anexo As Object Dim Mail_Objecto As Variant Dim Mail As Variant Email_Assunto = "Envio dos dados" Email_Enviado_De = "aaa@aaa.pt" Email_Enviado_Para = "aaa@aaa.pt" 'Email_Cc = "aaa@aaa.pt" 'Email_Bcc = "aaa@aaa.pt" MsgBox "E-mail enviado para aaa@aaa.pt", vbInformation, "OK" On Error GoTo debugs Set Mail_Objecto = CreateObject("Outlook.Application") Set Mail = Mail_Objecto.CreateItem(0) Mail.Subject = Email_Assunto Mail.to = Email_Enviado_Para Mail.cc = Email_Cc Mail.BCC = Email_Bcc Mail.Body = ActiveDocument.Content Mail_Anexo = ActiveDocument 'Mail_Single.Body = Email_Body Mail.Send debugs: If Err.Description <> "" Then MsgBox Err.Description End Sub

Boa tarde Gostaria de saber se alguém me podia ajudar com esta questão. O seguinte código envia via VBA um e-mail para joao@gmail.com, contendo informação acerca do array fornecedor: public sub enviaEmail() Dim Email_Subject, Email_Send_From, Email_Send_To, _ Email_Cc, Email_Bcc, Email_Body As String Dim Mail_Object, Mail_Single As Variant Email_Subject = "ALERTA AUTOMÁTICO - CONTRATOS" Email_Send_From = "joao@gmail.com" Email_Send_To = "joao@gmail.com" 'Email_Cc = "databison@gmail.com" 'Email_Bcc = "databison@gmail.com" 'If Time > "14:30:00" Then Email_Body = "Boa tarde - verifique os erros nos contratos (fundo vermelho). O primeiro fornecedor a verificar é: " & fornecedor(1) & "." 'End If 'If Time < "12:30:00" Then ' Email_Body = "Bom dia. Existe informação a carregar . É favor consultar o ficheiro de carregamentos" 'End If MsgBox "E-mail enviado para joao@gmail.com", vbInformation, "OK" On Error GoTo debugs Set Mail_Object = CreateObject("Outlook.Application") Set Mail_Single = Mail_Object.CreateItem(0) With Mail_Single .Subject = Email_Subject .to = Email_Send_To .cc = Email_Cc .BCC = Email_Bcc .Body = Email_Body .send End With debugs: If Err.Description <> "" Then MsgBox Err.Description End Sub O que eu pretendia era no corpo do e-mail enviar todo o conteúdo do array fornecedor, pois trata-se de um array dinâmico que vai sendo preenchido de acordo com critérios definidos numa outra função. Obrigado desde já.

Boa tarde, Tenho uma tabela onde existem peças,com prazos de entrega diferentes. Cada peça necessita de matéria prima para ser feita. Tenho uma macro que me diz quais têm matéria e quais não têm. O problema é que ao preencher as células existem peças com prazo mais pequeno de entrega onde me diz que não tenho matéria prima, e mais a frente tenho peças com mais validade onde já acusa ter matéria prima. O que eu pretendia fazer era: Ele verificava onde não tinha e iria substituir, mas retirando matéria as peças com prazo maior. Alguém me consegue dar uma luz de como posso fazer isso ? Já estou de roda disto a uma semana mas ainda não consegui lá chegar. Obrigado, Afonso Mira

Olá, estou com um loop infinito e não sei como resolver. Estou usando o evento change para saber se a célula foi altera. Em seguida vou passando por algumas Sub's. Ocorre que no célula data entro em loop sem sair. 01 - Imagem https://www.dropbox.com/s/csfh2iuwurzwuqy/vba_change.png?dl=0 02 - Codigo WorkSheet_Change Option Explicit Private Sub WorkSheet_Change(ByVal Target As Range) If Target.Address = "$C$2" Then Range("$C$2").NumberFormat = "dd/mm/yyyy" Valida_Data End If If Target.Address = "$E$2" Then Range("$E$2").NumberFormat = "@" Digita_Hora End If End Sub 03 - Modulos Option Explicit Dim str_Data_Inicio As String Dim str_Hora_Inicio As String Sub Valida_Data() If IsDate(Range("$C$2")) = True Then str_Data_Inicio = Mid(Range("$C$2"), 7, 4) & "-" & Mid(Range("$C$2"), 4, 2) & "-" & Mid(Range("$C$2"), 1, 2) ' Range("$E$2").ClearContents ' Range("$E$2").Select Digita_Hora Else MsgBox ("data inválida") Range("$C$2").Select End If End Sub Sub Digita_Hora() ' Range("$E$2").ClearContents Range("$E$2").Select If Len(Range("$E$2")) < 4 Or Len(Range("$E$2")) > 5 Then MsgBox ("Hora inválida, digite hora com 4 caracteres"), vbExclamation ' Range("$E$2").ClearContents Range("$E$2").Select Else MsgBox ("vou validar hora") Valida_Hora End If End Sub Sub Valida_Hora() ' str_Hora_Inicio As String ' MsgBox (str_Hora) If IsNumeric(Left(Range("$E$2"), 2)) And IsNumeric(Right(Range("$E$2"), 2)) Then str_Hora_Inicio = Left(Range("$E$2"), 2) & ":" & Right(Range("$E$2"), 2) str_Data_Inicio = str_Data_Inicio & " " & str_Hora_Inicio If Len(str_Hora_Inicio) = 5 Then Range("$E$2") = str_Hora_Inicio End If Else MsgBox ("Hora inválida, digita_hora") Digita_Hora Range("$E$2").ClearContents End If End Sub Sub Criar_Plan() MsgBox ("Criar Plan") End Sub Agradeço a quem puder me auxiliar. José Bonfim

Pessoal, eu preciso colocar meu programa para iniciar junto com o windows, mas meu programa tem um arquivo de configuração (app.config), como eu faço? agradeço desde já.

Boa noite!, tenho um problema em alterar 2 campos (1 campo em VB e outro campo em acess), tenho uma textbox que tem como mascara "000000000", para meter só numeros . e tenho um campo em acess em "numero", e queria alterar os 2 para escrever letras e numeros, como faço?

Bom dia! Tenho uma app concluída feita em visual basic express 2008, com base de dados em access 2010. Tenho um problema em uma texto box que tem como máscara "000000000" ou seja para só aceitar números, e em acess tenho uma tabela com um campo "referencia" que tem como numero. Acontece que a "referência" também leva letras e precisava de mudar para números e letras, como faço para que isso me aconteça, sem me dar erros na BD.

Tenho uma planilha feita no Excel 2003. Apesar de não ter macros, protegi o VBA com senha (Alt+F11 - Propriedades de VBAProject/Proteção), pois há uma planilha oculta como: 2 - xlSheetVeryHidden Por isso protegi o VBA, para que o usuário não torne a planilha oculta. Repito: não há módulos, formulários, macros, nada. Ao abrir no Excel 2007 em modo de compatibilidade, para minha surpresa o VBA está ativo, pois a senha sumiu. No Excel 2003 continua protegido, mas no Excel 2007 não.

Boa Noite, Sou Novo no VBA e estou a tentar desenvolver uma macro que me faça o seguinte: tenho Vários dados em 5 colunas e o que pretendo fazer é um filtro pela coluna [E] e que adicione novo livro em csv com o nome do filtro, mas se o livro já existir então vai colar os dados de acordo a coluna [A]. ex:macro faz filtro pela coluna E, copia linha 1, 2 para um novo livro com o nome 100, se esse livro já existe, então vai copiar os dados e colar na ultima célula preenchida se não existir as datas 15/08/2019 ou 16/08/2019, se as datas existirem então substituir os dados. O que tenho até agora é a seguinte macro que encontrei na internet. se me pudessem ajudar agradecia imenso, obrigado. Sub DistributeRowsToNewWBS() Dim wbNew As Workbook Dim wsData As Worksheet Dim wsCrit As Worksheet Dim wsNew As Worksheet Dim rngCrit As Range Dim LastRow As Long Set wsData = Worksheets("Folha1") ' name of worksheet with the data Set wsCrit = Worksheets.Add LastRow = wsData.Range("e" & Rows.Count).End(xlUp).Row ' column H has the criteria wsData.Range("e1:e" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True Set rngCrit = wsCrit.Range("A2") While rngCrit.Value <> "" Set wsNew = Worksheets.Add ' change E to reflect columns to copy wsData.Range("A1:E" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True wsNew.Name = rngCrit wsNew.Copy Set wbNew = ActiveWorkbook ' saves new workbook in path of existing workbook wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit wbNew.Close SaveChanges:=True Application.DisplayAlerts = False wsNew.Delete rngCrit.EntireRow.Delete Set rngCrit = wsCrit.Range("A2") Wend wsCrit.Delete Application.DisplayAlerts = True End Sub https://ibb.co/nQgNqM1

Bom dia a todos, Gostaria de saber se existe alguma forma de exportar os campos de uma tabela ou consulta no formato XML. A ideia seria criar um botão com um evento, que vai buscar os dados como por exemplo: (cliente, morada, cidade)...e exportar para XML capaz de ser guardado na área local.

Ola Boa Tarde amigos; Estou com gigantesco problema Criei um arquivo para o rh da empresa. mais porem criei na minha maquina ao executar em outras maquinas ele nao exibe o LISTVIEW1 NA OUTRA MAQUINA,OQUE EU FAÇO !

Se alguém souber como fazer conexão entre dois arquivos do Excel, ambos por VBA por exempl tenho 3 planilhas as planilhas 1 e 3 servem como se fosse um sistema e a 2 como um banco de dados existe essa possibilidade eu ter cada planilha em uma maquina diferente e elas ficarem interligadas uma a outra ??? como... desde ja agradeço

Alguem pode me ajudar, tenho um projeto vba, e ja esta nos finalmentes conforme eu queria, porem gostaria de criar um banco de dados para utiizar nele como eu faço isso ?

Boa Tarde !!! Preciso do conhecimento maior desta coletividade, tentei desenvolver de diversas formas um código para imprimir uma listbox completa para qualquer formato que permita imprimir fisicamente após, entretanto, nenhum código foi bem sucedido, recorro agora a alguma outra alternativa por indicação da comunidade. Atenciosamente.

preciso um textbox no VBA que retorne o valor de 0,00 para o textbox apos informação enviada ! por exemplo envio o valor de 150,00 para uma planilha e retorna para o textbox 0,00 para que u possa digitar novamente outro valor em cima ou deixar o valor em 0,00 mesmo !

Olá amigos, sou novo na programação com VBA, e preciso de uma ajuda, criei um formulario para registro de gastos com funcionarios, e não quero que fiquem celulas em branco porem nao sao todas que sao necessarias um valor como deixar um valor dentro do textbox que mesmo depois de salva a informação ele retorne para o textbox

Ola pessoal boa tarde, sou novo ainda no VBA. Bom, eu queria um código para que quando aparecer o valor aleatório na célula x, ele gere valores impares até o valor daquela célula X. Por exemplo. Valor da célula X= 304 (valor aleatório) Gerar uma coluna inteira, do A1=5 ATE A289= 300. com os valores espaçados a cada 8 linhas entre eles. Ou seja: A1= 5 pula 8 linhas A9=10 e etc... Comecei com algo, porem quando eu digito valores aleatórios pares ele gera valores até o final da coluna. Vou agradeçer muito se der para ajudarem. Private Sub BtExecuta_Click() Dim w As Worksheet Dim ln As Long Dim col As Integer Dim varray() As Long Set w = Plan6 ln = 5 col = 1 Do Until ln = Plan6.Cells(1, 3).Value w.Cells(ln, col).Value = ln ln = ln + 5 Loop End Sub