Basole

@Gueds eu testei várias vezes este exemplo e funcionou 100%. Não sei quais mudanças você fez, mas vendo as imagens que postou me parece que alternou o exemplo mesclando códigos da sua postagem de ontem. Sendo assim, fica difícil diagnósticar o que está acontecendo. Sugiro baixar novamente o meu exemplo, descompactar e abrir o arquivo, que automaticamente a numeração vai alterar para 0121/2021 pois a macro é executada ao abrir o arquivo, sem botões. * Lembrando que o arquivo autonure.txt, deve estar na mesma pasta o arquivo de exemplo do word, conforme configuração da macro. Quanto a sua dúvida de como inserir o controle de conteúdos, sugiro acompanhar este vídeo abaixo, para se orientar melhor e no seu documento original, altere este controle para Autonumeraçao em propriedades

Segue exemplo em anexo: Ao abrir o arquivo do Word, é incrementado o valor +1, / (a barra) e o ano atual. E no arquivo de texto é atualizado, no formato: "120" * No seu documento original, deve ser inserido um controle de conteúdo, conforme o exemplo em anexo: Sobre controles de conteúdo Exemplo_Numeracao_Automatica.zip

@Gueds minha sugestão e criar um arquivo *.TXT para armazenar a última numeração utilizada e atualizar a cada abertura do arquivo do word. Acho que já postei aqui mesmo um exemplo... Encontrei aqui: Numeração automática.....

@Isabele Vasconcelos eu não gosto de usar a propriedade RowSource, sempre gera erros. Experimente a propriedade List. Veja o exemplo a baixo: Private Sub UserForm_Initialize() Dim myArray As Variant Dim linha As Long With ThisWorkbook With .Sheets("RELAÇÃO DE FUNCIONÁRIOS") linha = .Cells(Rows.Count, "B").End(xlUp).Row myArray = .Range("B9:B" & linha).Value2 Me.cxtexto_funcionario.List = myArray End With With .Sheets("Planilha2") linha = .Cells(Rows.Count, "K").End(xlUp).Row myArray = .Range("K1:K" & linha).Value2 Me.cxtexto_medida.List = myArray linha = .Cells(Rows.Count, "C").End(xlUp).Row myArray = .Range("C2:C" & linha).Value2 Me.cxtexto_motivo.List = myArray End With End With End Sub

@josequali veja se é isso que entendi: Para carregar os dos dados na combobox, filtro2 (empesa), usei o evento change da combobox filtro1 Private Sub filtro1_Change() Call empresacombobox End Sub Para carregar os dos dados na combobox, filtro1 (Ramal), useio evento Activate, do userform Private Sub UserForm_Activate() Call Ramalcombobox End Sub E na rotina empresacombobox, fiz apenas uma alteracao referenciando os dados do filtro1 Sub empresacombobox() conectdb 'esse comando deveria permiti carregar os nomes das empresas ao se relaciona com coluna ramal rs.Open "Select distinct Empresa from TabCadastro Where Ramal like '%" & Me.filtro1.Text & "%' order by Empresa", db, 3, 3 Me.Filtro2.Clear Do Until rs.EOF Me.Filtro2.AddItem rs!Empresa rs.MoveNext Loop FechaDb End Sub * Desconsiderei o evento Initialize do Userform.

@Wanderson VP o erro é provavelmente que na pagina Fundamentus pesquisada, nao tenha encontrado nada * Tente alterar a linha abaixo referenciando o nome da planilha antes do endereço da celula cells(2,1) E certifique-se que na celula A2, da respectiva aba, tenha dados (dados da pesquisa). Exemplo: ie.document.getElementsByTagName("input")(0).Value = Planilha2.Cells(2, 1).Value

@josequali No ListBox, seus campos aceita valores em branco. O problema é que no BD Access, o campo em branco o valor é Null, por isso o erro. Para dribrar este problema, fiz uns ajustes na função TransposeArray: Public Function TransposeArray(myarray As Variant) As Variant Dim X As Long Dim Y As Long Dim Xupper As Long Dim Yupper As Long Dim tempArray As Variant Xupper = UBound(myarray, 2) Yupper = UBound(myarray, 1) ReDim tempArray(Xupper, Yupper) For X = 0 To Xupper For Y = 0 To Yupper If VBA.IsNull(myarray(Y, X)) Then tempArray(X, Y) = "" Else tempArray(X, Y) = myarray(Y, X) End If Next Y Next X TransposeArray = tempArray End Function

@Joyce Freitas segue um exemplo Sub Importar_Varios_CSV() Dim fPath As String Dim fCSV As String Dim wbCSV As Workbook Dim wbMST As Workbook Set wbMST = ThisWorkbook fPath = "C:\Users\usuario\Desktop\" ' coloque aqui o caminho (pasta) dos CSV(S) Application.ScreenUpdating = False Application.DisplayAlerts = False fCSV = VBA.Dir(fPath & "*.csv") On Error Resume Next Do While Len(fCSV) > 0 Set wbCSV = Workbooks.Open(fPath & fCSV) wbMST.Sheets(ActiveSheet.Name).Delete ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count) Columns.AutoFit fCSV = Dir On Error GoTo 0 Loop Application.ScreenUpdating = True Set wbCSV = Nothing End Sub

@josequali Esta acontecendo isso, porque no seu codigo ao selecionar 1 item do listbox, esta fazendo uma nova consulta ao BD. Nesta caso nao e necessario, pois os dados ja estão dispostos no listbox. Segue as alteracoes: Private Sub ListBox1_Click() With ME.ListBox1 If .ListIndex > -1 Then Me.txtnome.Text = .List(.ListIndex, 1) Me.txtsexo.Text = .List(.ListIndex, 2) Me.txtidade.Text = .List(.ListIndex, 3) Me.txtcpf.Text = .List(.ListIndex, 4) Me.txtrg.Text = .List(.ListIndex, 5) Me.txtendereco.Text = .List(.ListIndex, 6) Me.txtbairro.Text = .List(.ListIndex, 7) Me.txtdata.Text = .List(.ListIndex, 8) Me.txtcep.Text = .List(.ListIndex, 9) Me.txttelefone.Text = .List(.ListIndex, 10) End If End With End Sub

@AfonsoMira desculpe!!! Estou no celular, e acabei trocando as bolas, quanto aos tópicos

@josequali Dica: grava uma macro e manualmente, cole os dados do access em um intervalo e insira o gráfico desejado referenciando os intervalos com as informações. Desta forma fica mais fácil ajudarmos a adaptar este código, na parte de importação dos dados do access e a exportação do gráfico como imagem *.Gif e o carregamento no userform.

@josequali segue abaixo o código com as alterações, Veja se é isso: Private Sub BtnCadastro_Click() Dim vl As Boolean Dim Ctrl As Control ' VERIFICA SE TODOS OS CAMPOS FORAM PREENCHIDOS: If CadNome.Text = "" Or _ CadSenha.Text = "" Or _ CadUsuario.Text = "" Then MsgBox "Preencha todos os campos para proseguir! ", vbCritical, "Aviso" Exit Sub End If ' VERIFICA SE OS OPTIONBUTTON FORAM SELECIONADOS: For Each Ctrl In Me.Frame1.Controls If TypeName(Ctrl) = "OptionButton" Then If Ctrl = True Then vl = True End If Next Ctrl If vl = False Then MsgBox "Escolha uma opção em " & _ Me.Frame1.Caption, vbCritical, "Aviso": Exit Sub vl = False For Each Ctrl In Me.Frame2.Controls If TypeName(Ctrl) = "OptionButton" Then If Ctrl = True Then vl = True End If Next Ctrl If vl = False Then MsgBox "Escolha uma opção em " & _ Me.Frame2.Caption, vbCritical, "Aviso": Exit Sub Conectdb Rs.Open "Select * from TabLogin", DB, 3, 3 If Not Rs.EOF Then With Rs .AddNew !Nome = Login.CadNome.Text !Usuario = Login.CadUsuario.Text !Senha = Login.CadSenha.Text If opt1 = True Then !Cadastrar = opt1.Caption Else !Cadastrar = opt2.Caption End If If opt3 = True Then !Imprimir = opt3.Caption Else !Imprimir = opt4.Caption End If .Update End With End If FechaDb MsgBox "Cadastrado com Sucesso!", vbInformation, "SALVO" End Sub

@josequali fiz as alteracoes solicitadas no arquivo do seu outro topico, que acredito ser o mesmo assunto. Veja se é isso: Projeto teste_v1.rar

@josequali segue as alteracoes veja se e isso que precisa. Acrescentei no cadastro a verificacao, se ja existe o nome de usuario no BD. Painel teste.rar

@josequali pra mim tá normal, testando o seu proprio arquivo: Experimente alterar esta linha do listbox: .List = rsArray * A funcao Transpose, as vezes da imcompatibilidade. Entao, tente usar esta função. Cole no modulo 1: Public Function TransposeArray(myarray As Variant) As Variant Dim X As Long Dim Y As Long Dim Xupper As Long Dim Yupper As Long Dim tempArray As Variant Xupper = UBound(myarray, 2) Yupper = UBound(myarray, 1) ReDim tempArray(Xupper, Yupper) For X = 0 To Xupper For Y = 0 To Yupper tempArray(X, Y) = myarray(Y, X) Next Y Next X TransposeArray = tempArray End Function E no Listbox: .List = TransposeArray(rsArray) @josequali * Atualizei as informações !!!!

@josequali neste caso voce tem que eliminar parte do seu codigo e considerar minha Sugestão. Fazendo os ajustes, veja como ficou: Private Sub BtnBuscar_Click() Dim vBusca As String Dim LinhaListbox As Integer Dim rsArray As Variant vBusca = TextBox5.Text conectdb 'conectar ao banco de dados e carregar rs.Open "Select * from TabCadastro where Nome like'" & Replace(vBusca, "'", "''") & "%'" & _ "or Codigo like '" & Replace(vBusca, "'", "''") & "%'" & " or Idade like '" & Replace(vBusca, "'", "''") & "%'" & " or Sexo like '" & Replace(vBusca, "'", "''") & "%'", db, 3, 3 If Not rs.EOF Then rsArray = rs.GetRows With ListBox1 .Clear .ColumnCount = 12 .ColumnWidths = "30;200;100;100;100;100;100;100;100;100;100;100" .List = Application.Transpose(rsArray) .ListIndex = -1 End With End If ContagemdeLinhas.Caption = ListBox1.ListCount & " registros encontrados" 'contagem de linhas ContagemdeLinhas.Width = 144 ' ajusta a largura da label FechaDb 'fehcar o banco de dados End Sub

@josequali experimente criar uma matriz para carregar os dados obtidos na pesquisa no access e na propriedade list do listbox carregar a matriz, desta forma o listbox é dimensionado, não gerando o erro de adicionar itens em mais de 10 colunas. Ex Dim rsArray As Variant. ......... rsArray = rs.GetRows ............. With Listbox1 .Clear .ColumnCount = 12 .List = Application.Transpose(rsArray) .ColumnWidths = "30;200;100;100;100;100;100;100;100;100;100;100" .ListIndex = -1 End With

Em vba seria mais ou menos assim: Dim x x = Int((VBA.sqr((VBA.Year(VBA.Date) + 1) * (VBA.Month(VBA.Date) + 1) * _ (VBA.Day(VBA.Date) + 1) * VBA.sqr(VBA.Hour(VBA.Time) + 1) * _ VBA.sqr(VBA.Minute(VBA.Time) + 1) * (VBA.Second(VBA.Time) + 1) * _ 12345678))) + 10 ^ 7 Debug.Print x

@josequali em anexo a solucao. * Para testar, baixe os arquivos PdfTk.exe, Libiconv2.dll e salve na mesma pasta da planilha junto com o arquivo PDF modelo (em anexo) Add_Rodapeh_PDF.zip

@josequali com o pdftk, é possível fazer o que você quer. Baixe o utilitário pdftk free, que é gratuito, e através de linha de comando + vba acredito que conseguira estampar o rodapé em seus arquivos escaneados salvos em pdf. https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/

@Luciana Goes segue o código com as alterações, com a altura da linha para 0,46 cm Sub Formatarlinhaword() Dim caminho As String Dim nome As String Range("B2:B6").Copy Range("D2").Value = Environ("USERPROFILE") caminho = Range("d3").Value nome = Range("d4").Value Set wrdApp = CreateObject("Word.Application") wrdApp.Visible = True Set wrddoc = wrdApp.Documents.Add With wrddoc .Activate .Range.Paste With .Tables(.Tables.Count) '.AutoFitBehavior wdAutoFitWindow .Rows.SetHeight RowHeight:=wrddoc.Application.CentimetersToPoints(0.46), _ HeightRule:=wdRowHeightExactly 'Ajusta Altura da linha End With Selection.Cells.Merge If Dir(caminho & nome) <> "" Then Kill caminho & nome End If .SaveAs (caminho & nome) .Application.Quit End With Set wrddoc = Nothing Set wrdApp = Nothing Application.CutCopyMode = False Set wrddoc = Nothing Set wrdApp = Nothing Application.CutCopyMode = False Range("b3").Select End Sub * Marque a referencia "Microsoft Word xx.x Object Library" na sua planilha do Excel

@Gislenea veja se este exemplo que gera codigo de barras lhe ajuda. * Caso nao consigua adaptar envie sua planilha ou um exemplo com alguns dados ficticios. Exemplo Codigo Barras_1 - Basole.zip

@Raquel Coelho Segue com as alteracoes: MODELO_V2.rar

@Raquel Coelho Se cada item do Listbox devem ser inseridos nas linhas abaixo, na plan Orcamento, entao os demais dados, dos textbox, combobox, etc, entendo que esses dados devem ser repedidos, como um banco de dados. Seria isso?

@Raquel Coelho veja se e isso que precisa no momento MODELO_v1.zip