Martti

@Midori Mais uma vez, muito agradecido pela solução.

Olá senhores. Tenho um formulario(UserForm1) no Excel com 14 textbox(txt1 até txt14) e um botão Gerar Documento. Ao clicar no botão btnGerarDocumento, deve abrir um documento na rede( \\caminho\para\sua\pasta\AIF.docx), documento este que possui 14 Campos de Texto(Controle de Formulario), preencher de Campo1 até Campo14 com as informações do UserForm1, na mesma ordem. Estou com erro em .ActiveDocument.Close (SalvarDocumento) e não consigo resolver. Agradeço desde já pela ajuda. Option Explicit Private ObjWord As Object Private ObjDocument As Object Private Function AbrirDocumentoWord(NomeArquivoWordModelo As String) As Boolean ' Invoca o Word Set ObjWord = CreateObject("Word.Application") ' Se ocorrer erro, prossiga (pois checarei se houve erro logo após o comando que pode ter dado problema On Error Resume Next ' Tenta abrir um novo documento Word a partir de um modelo Set ObjDocument = ObjWord.Documents.Add(NomeArquivoWordModelo, False, 0, False) ' Checa se houve erro If Err <> 0 Then ' Restaura o tratamento padrão de erros On Error GoTo 0 Err = 0 ' Ocorreu erro na tentativa de abertura do documento Word AbrirDocumentoWord = False ' Interrompe a execução desta Function Exit Function End If ' Restaura o tratamento padrão de erros On Error GoTo 0 ' Abertura de documento Word foi bem-sucedida AbrirDocumentoWord = True End Function Private Sub PreencheCampo(NomeCampo As String, ConteudoNovo As String) With ObjDocument ' Verifica se o campo a preencher existe If .Bookmarks.Exists(NomeCampo) Then ' O campo existe ' Preenche o campo indicado .Bookmarks(NomeCampo).Range.Fields(1).Result.Text = ConteudoNovo End If End With End Sub Private Sub ExibirWord() ObjWord.Visible = True End Sub Private Sub FecharWord(SalvarDocumento As Boolean) ' Fecha o documento Word With ObjWord .ActiveDocument.Close (SalvarDocumento) .NormalTemplate.Saved = True End With ' Fecha o Word ObjWord.Quit End Sub Private Sub cmdGerarArquivoWord_Click() Dim NOME_ARQUIVO As String NOME_ARQUIVO = "\\caminho\para\sua\pasta\AIF.docx" ' Desabilita o botão de comando cmdGerarArquivoWord.Enabled = False ' Tenta abrir documento Word If Not AbrirDocumentoWord(NOME_ARQUIVO) Then ' Reabilita o botão de comando cmdGerarArquivoWord.Enabled = True ' Fecha o Word, mas sem salvar o documento FecharWord False ' Houve erro. Interromper execução desta Sub Exit Sub End If ' Abertura do documento Word foi bem-sucedida ' --- Preenche os campos do documento Word com os conteúdos desejados ----------------------- '************************************************************************************* ' Exibe o Word ExibirWord ' Reabilita o botão de comando cmdGerarArquivoWord.Enabled = True End Sub

UP! Algum dos colegas poderia melhorar este código? Funciona 90%, mas ao atingir o limite de altura da linha (255 pixels), ele não divide o texto adicionando uma linha abaixo. Pode ser testado na planilha deste tópico. Agradeço desde já. 'Code generated by OpenChat 16/04/2023 Sub FormataCélulas() Dim cw As Double, rh As Double, cwA As Double, c As Range With Range("B42:AF42") .MergeCells = False cwA = .Cells(1).ColumnWidth For Each c In .Cells cw = cw + c.ColumnWidth Next c cw = cw + .Count * 0.66 ' .Cells(1).ColumnWidth = cw .Cells(1).WrapText = True .EntireRow.AutoFit rh = .RowHeight .Cells(1).ColumnWidth = cwA .MergeCells = True .RowHeight = rh .HorizontalAlignment = xlJustify .VerticalAlignment = xlJustify End With End Sub

@Midori, obrigado pela contribuição. Pensei nisso inicalmente, mas como a digitação de dados já é feita em formulários no excel, seria selecionar o registro no listbox e apertar um botão "Imprimir". Se não fosse esse único campo, de 20 campos, o relatório impresso já estaria em funcionamento. Aliás, sempre funcionou até então, mas foi necessário inserir este campo com a avaliação da não conformidade, que era de outro relatório. Como já existe essa máscara de relatório pronta, com logotipo, cabeçalho etc., e há muito tempo já é utilizada com VBA, pelas boas práticas a probabilidade de erro é menor. Foi a inserção desse campo que impactou nesse único e gigantesco problema, porque a empresa quer que continue no Excel. Manda quem pode, obedece quem tem juízo. Já pesquisei muito, mas ainda não conseguir unir em uma macro o split, vbNewLine e Range.MergeCells. Se alguém puder colaborar ou pensar fora da caixa, agradeço desde já. @Midori, mais uma vez, como sempre, agradeço pela sugestão.

@Goobsegue a planilha para melhor entendimento Quem puder ajudar, agradeço desde já. Conformidade.zip

Salve colegas! Já resolvi 90% do modelo de relatório pedido, mas tenho ainda uma questão pendente. Os dados são registrados na Plan2(Base) através de um formulário padrão. Na Plan3(Relatorio) existe um modelo de relatório, com células referenciadas por PROCV até então fácil de preencher com dados numéricos. Existe uma determinada célula referenciada na Plan2(Base) que tem que ser preenchida com o texto do relatório de conformidade. Como a altura máxima da célula é de 255 pixels, o texto não cabe nesta célula(B42) pois ultrapassa em muito esse tamanho. A largura do formulário vai da coluna B até coluna AF, portanto, tenho limites laterais, mas sem limites de linhas. Já quebrei a cabeça, então peço ajuda dos mais experientes. Preciso de um código que insira o texto de B42 até AF42, quebre o texto, insira* uma linha abaixo(B43:AF43), no mesmo limite lateral e assim sucessivamente, até a ultima linha do texto. O texto varia muito de tamanho, na maioria das vezes mais de uma página, por isso tem que inserir linhas, tem campos abaixo e não posso ter espaço em branco, senão criaria um range definido, com células mescladas. Pensei em criar um split com o próximo espaço vazio depois de 100 caracteres e jogar o texto para baixo, mas não consegui implementar o código. Agradeço desde já a ajuda de todos. *não pode pular linhas pois há mais campos abaixo, acaba sobrepondo os campos.

Depois de muitos testes, uma apanhado de códigos que resolveram minha necessidade. Necessário adequação para problemas específicos. Sub FormataCélulas() Application.ScreenUpdating = False Dim cw As Double, rh As Double, cwA As Double, c As Range Dim lng As Long, lastrow As Long With Range("A32:AD32") .MergeCells = False cwA = .Cells(1).ColumnWidth For Each c In .Cells cw = cw + c.ColumnWidth Next c cw = cw + .Count * 0.66 .Cells(1).ColumnWidth = cw .Cells(1).wrapText = True .EntireRow.AutoFit rh = .RowHeight .Cells(1).ColumnWidth = cwA .MergeCells = True .RowHeight = rh .HorizontalAlignment = xlJustify .VerticalAlignment = xlJustify End With '------------------------------------------------------------------------------------------------------------------------------- For lng = lastrow To 1 Step -1 If Rows(lng).RowHeight > 408 Then Rows(lng + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Rows(lng).Resize(1).Select Selection.RowHeight = 409 Cells(lng, "A").Resize(1, 32).Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlTop .wrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ReadingOrder = xlContext .MergeCells = True .ShrinkToFit = True End With End If If lastrow > 1 Then ActiveCell.Offset(-1, 0).Range("A32:AD32").Select End If lastrow = lastrow - 1 Next Application.ScreenUpdating = True End Sub

Olá Senhores! Mais uma vez recorro ao conhecimento dos colegas aqui do fórum. No tópico anterior, este aqui, o problema foi resolvido com a colaboração dos colegas. Porém, com implementações, o relatório ficou mais detalhado. Por padrão, a altura de linha do Excel tem limite de 409 pontos e o texto atual de alguns relatórios tem superado este espaço, cortando o texto. Alguns relatórios utilizam 2 à 3 páginas Sei que o Excel não é a melhor ferramenta para esse fim, mas é o que tem para o momento. Se algum colega tiver ideia melhor de usar máscara de relatório ou resolver esse problema de mais de uma linha, agradeço desde já. Replicando o tópico original: "A empresa utiliza uma planilha que é uma máscara de formulário, onde as células são preenchidas facilmente com as funções INDICE+CORRESP. Porém, há um campo dinâmico, o único a ser preenchido, que não consigo resolver por VBA. Na célula A32 deve ser digitado um relatório de conformidade e vistoria. Esse relatório pode conter de 5 à "n" linhas. Manualmente é fácil mesclar as células, quebrar o texto e justificar o alinhamento do texto. Geralmente vai até o limite impresso do relatório, coluna T. Devido à essa variação do número de linhas do relatório e não poder haver linhas em branco, não consigo criar uma macro para mesclar as células, quebrar o texto e justificar o alinhamento, caso contrário seria só fixar uma range(A32:T"n") e aplicar a macro." cs_modelo.zip

@Midorisem modéstia, ambas colaborações resolvem meu problema, de modos diferentes, mas atingem o mesmo propósito. Há situações onde preciso de tabela organizada por colunas e outras situações onde só uma coluna resolve o ÍNDICE+CORRESP. Por isso agradeço aos dois colegas por compartilharem do conhecimento, mais cebeças pensam melhor do que uma. Hoje ou amanhã devo postar outra situação para totalizar 3 planilhas diferentes... Começo de ano, com novas filiais e/ou terceirizados é uma tempestade de planilhas ainda sem padronização. E não sou programador, mas a necessidade é a mãe da criatividade...

@Midori e @OreiaG muito obrigado por me auxiliarem nesse problema. Apenas indiquei a resposta do Midori como solução porque respondeu anteriormente, mas ambas as respostas resolvem prontamente a situação. Agradeço por compratilharem vosso tempo e vosso conhecimento.

Bom dia senhores. Recorro mais uma vez ao conhecimento dos colegas. Passei a receber um arquivo em excel que foi convertido de um PDF. Essas conversões deixa a desejar, pois muitas vezes quebram tabelas, linhas e tabulações. O arquivo original em PDF possui 159 páginas, o que gera um arquivo .xls com 159 planilhas. Preciso juntar todas as planilhas em uma só, em sequencia, para organizar os dados e tabelas para gerar os relatórios. Em anexo envio um arquivo com uma situação semelhante. Desde já agradeço pela ajuda. Relacao-das-ruas-agupadas-por-bairro-em_01_12_22.zip

@OreiaGMuito obrigado por compartilhar seu tempo e seu conhecimento. Atendeu plenamente minha necessidade.

@ScofieldgynEncaminho um modelo com dados ficitícios, mas que atende minha necessidade. As células com margem são preenchidas através das funções ÍNDICE+CORRESP. Na célula A42 íncia uma região dinâmica, podendo ser de 5 à "n" linhas. Essa range tem que se auto-ajustar, delocando linhas para baixo ou para cima. Manualmente é fácil mesclar as células, quebrar o texto e justificar o alinhamento do texto. Geralmente vai até o limite impresso do relatório, coluna AD. Devido à essa variação do número de linhas do relatório e não poder haver linhas em branco, não consigo criar uma macro para mesclar as células, quebrar o texto e justificar o alinhamento, caso contrário seria só fixar uma range(A42:AD"n") e aplicar a macro. Agradeço desde já a ajuda recebida. cs_modelo.zip

@ScofieldgynPerfeitamente, já estou trabalhando nas modificações, apenas adiantei o pedido de ajuda para iniciar a discussão sobre o problema. Grato pelo seu tempo.

Olá Senhores! Mais uma vez recorro ao conhecimento dos colegas aqui do fórum. A empresa utiliza uma planilha que é uma máscara de formulário, onde as células são preenchidas facilmente com as funções INDICE+CORRESP. Porém, há um campo dinâmico, o único a ser preenchido, que não consigo resolver por VBA. Na célula A32 deve ser digitado um relatório de conformidade e vistoria. Esse relatório pode conter de 5 à "n" linhas. Manualmente é fácil mesclar as células, quebrar o texto e justificar o alinhamento do texto. Geralmente vai até o limite impresso do relatório, coluna T. Devido à essa variação do número de linhas do relatório e não poder haver linhas em branco, não consigo criar uma macro para mesclar as células, quebrar o texto e justificar o alinhamento, caso contrário seria só fixar uma range(A32:T"n") e aplicar a macro. Agradeço desde já a ajuda recebida.

@AfonsoMira Boas! Muitíssimo obrigado mais uma vez por compartilhar seu conhecimento. Resolveu plenamente meu problema!

Salve amigos! Mais uma vez recorro ao vasto conhecimento dos integrantes desse forum. Recebi uma planilha de um departamento e estou com problemas com a busca e referência. Na Plan2 existem 4 colunas, K, Q, BD e BC. A coluna K tem o nome de ROUTER1 e a coluna Q, ROUTER2, coluna BC, PASS1 e coluna BD, PASS2 A TABELAB de referência está na Plan3("REF") com 3 colunas e 668 linhas Se a coluna K tiver informação, faz um PROCV na 2ª coluna da TABELAB e retorna o valor na coluna BC e na 3ª coluna da TABELAB e retorna o valor na coluna BD. Se a coluna K estiver vazia, o valor a ser considerado é o da mesma linha na coluna Q, faz um PROCV na 2ª coluna da TABELAB e retorna o valor na coluna BC e na 3ª coluna da TABELAB e retorna o valor na coluna BD. Resumindo, havendo K & i, BC & i e BD & i serão preenchidos Não havendo K & i, Q & i passa a ser referência, BC & i e BD & i serão preenchidos. O código abaixo não funciona. Quem puder compartilhar conhecimento para acertar o código, agradeço desde já. Sub PASS_TEST() '*********************************************************** Dim ROUTER1, ROUTER2, TABELAB As Range Dim ultLinha As Integer Dim resultado_procv As Variant Dim i As Integer Application.ScreenUpdating = False ultLinha = Sheets("Plan2").Cells(Cells.Rows.Count, 1).End(xlUp).Row Set TABELAB = Sheets("REF").Range("a2:c668") Set ROUTER1 = Sheets("Plan2").Range("K" & ultLinha) Set ROUTER2 = Sheets("Plan2").Range("Q" & ultLinha) Sheets("Plan2").Select For i = 2 To ultLinha If ROUTER1 <> "" Then ROUTER1 = Sheets("Plan2").Range("K" & i).Value resultado_procv = Application.VLookup(ROUTER1, TABELAB, 2, False) Sheets("Plan2").Range("BD" & i).Value = resultado_procv ElseIf ROUTER1 = "" Then ROUTER1 = Sheets("Plan2").Range("Q" & ultLinha).Value resultado_procv = Application.VLookup(Bairro2, TABELAB, 2, False) Sheets("Plan2").Range("BD" & i).Value = resultado_procv End If Next i i = i + 1 End Sub

@Midori Parabéns pela solução do problema, melhor impossível. Vou me debruçar sobre o código para adquirir mais conhecimento. Muito obrigado por compartilhar seu tempo e seu conhecimento. Sua ajuda foi por demais importante...

@MidoriIsso mesmo, o status se modifica ou não a partir da atualização da linha. Na verdade, acredito que preciso eliminar o status FINALIZADO. A proxima data de calibração será estipulada no momento da realização da mesma***, onde cada chefe de setor saberá se será em até 30, 60 ou 90 dias. Como no exemplo acima, quando a importação dos dados atualizar a 3ª calibração, preencherá tb a 4ª calibração com uma data estipulada***, o status passará a "vencerá em xx dias" Por isso penso em tirar o status FINALIZADO, ficando só VENCIDO HÁ XX DIAS, VENCE HOJE, VENCERÁ EM XX DIAS, porque quando a calibração é feita, a proxima calibração é preenchida***, reiniciando a contagem. Como no exemplo, quando a 3ª calibração foi feita, o status anterior era "VENCIDO HÁ 1 DIAS" (HOJE() - 22/03/2022). Quando a planilha foi atualizada e a data da 3ª calibração foi inserida, a data da 4ª calibração tb foi inserida(23/04/2022), então, hoje, 24/03, executando o código, este buscará a última célula preenchida da linha, o status mudará "VENCERÁ EM 29 DIAS". Como no exemplo, se não houve a 3ª calibração para a linha 2, o status permanecerá "VENCIDO HÁ XX DIAS" até que o código identifique alguma data na 3ª calibração, que passará a ser a última célula com data na linha 2. Assim penso em somente 3 status, à medida que as calibrações forem sendo atualizadas. Coloco-me à disposição para esclarecimentos. Obrigado pelo seu tempo. ***defini essa mudança com a chefia por me parecer mais objetiva, visto a volatilidade das datas. No meu analfabetismo em variáveis, pensei neste conceito: Sub Status() Dim Linha As Double Linha = 1 Dim ColunaStatus As Double Dim ColunaData As Double Dim ultimalinha As Long Dim lin As Long ultimalinha = Range("A" & Rows.count).End(xlUp).Row For lin = 2 To ultimalinha ColunaStatus = 9 ColunaData = Range("J" & lin).End(xlToRight).Column With Plan1 Do Linha = Linha + 1 . . . . . . End Sub

@Midori Isso mesmo, excelente entendimento! Sempre que as datas forem atualizadas(importadas), a mudança de status deve ser feita pela ultima celula preenchida na linha + 1( penultima e ultima). Se a ultima celula preenchida for <>"", então: If ultima<Hoje = Status =Vencida à & Hoje-ultima & dias If ultima=Hoje = Status = Vence Hoje If ultima>Hoje = Status = Vencerá em & ultima-Hoje & dias Else OK (preciso melhorar isso, aceito sugestões) Um detalhe é que as maquinas tem períodos de calibração diferentes, não sendo possível fixar que calibração 2 será calibração 1 + 30 (ou 60, 90) dias. O status mudará sempre que houver acréscimo de calibração. Agradeço pelo seu tempo.

@Midori Desculpe a falha calibracao.zip

@Midori Obrigado pela atenção. No VBE tem um módulo com o código que eu utilizava anteriormente. Em virtude de mudanças administrativas, a planilha teve que ser alterada. O código compara a coluna J com a coluna K e atualiza o status na coluna I. Na medida que as calibrações são efetuadas, os registros avançam nas colunas, então, no exemplo, a proxima calibração(colunaL) deverá ser comparada com a coluna anterior(coluna K) e assim por diante. Sim, poderia usar formulas e até formatação condicional por cores, mas obrigatoriamente tem que ser em VBA. Grato pelo seu tempo.

Salve amigos! Mais uma vez recorro ao vasto conhecimento dos integrantes desse forum. Em anexo uma planilha de agendamento de calibração de instrumentos. O código é adaptado de uma outra planilha, mas com um range de 2 colunas Preciso que localize a última célula preenchida da linha e execute o código. Os dados da coluna 1ª Calibração até 10ª Calibração são importados de outra planilha, Só preciso atualizar o status à cada importação, porém o período de calibração de cada máquina é diferente e são incrementais. Consegui resolver para a primeira coluna, mas meu conhecimento me limita a este ponto. Quem puder ajudar, agradeço desde já. Abs calibracao.zip

Amigos, resolvi quase a totalidade do problema mas necessito de ajuda para melhorar o código abaixo para aparecer a ListRow de 10 linhas? Private Sub ComboBox11_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim arrIn As Variant, arrOut As Variant Dim i As Long, j As Long arrIn = Plan6.Range("log") ReDim arrOut(1 To UBound(arrIn), 1 To 1) For i = 1 To UBound(arrIn) If arrIn(i, 1) Like "*" & ComboBox11.Text & "*" Then j = j + 1 arrOut(j, 1) = arrIn(i, 1) End If Next ComboBox11.List = arrOut End Sub

Salve amigos! Mais uma vez recorro ao vasto conhecimento dos integrantes desse forum. Tenho uma ComboBox no formulário que é populado por um identificador alfanumérico que é uma sequência de outras TextBox. Como são várias origens, este identificador possui 15 caracteres, porém em sequências diferentes. Por exempo, RBP1578F2TRN830, GRU18CNF1235745, etc. O identificador pode começar com letra ou número. Nexta ComboBox, preciso da função autocompletar por qualquer parte do texto da RowSource, não pelas iniciais, pois pesquisando uma sequência de letras ou números em qualquer posição eu reduzo muito o universo da pesquisa. Exempo: Pedro, José e Manoel. Se eu digitar a letra "e" aparecem 3 nomes, mas digitando a letra "s" aparece só José. Quando era planilha eu conseguia com o código abaixo, mas no formulário já vai além do meu conhecimento. Desde já agradeço a ajuda de todos. '--------------------------------------------------------------------------------------- ' Module : UserForm1 ' Author : MVP, Sergio Alejandro Campos ' Date : 19/02/2016 ' Purpose : Búsqueda "as type" '--------------------------------------------------------------------------------------- '1)Al iniciar Private Sub UserForm_Initialize() Me.Height = 181 End Sub '2)Al escribir texto en el TextBox Private Sub TextBox1_Change() TextBox1.Text = UCase(TextBox1.Text) TextBox1.SelStart = Len(TextBox1) If Me.TextBox1.Value = "" Or Me.TextBox1.Value = " " Then Me.Height = 181 Else Me.Height = 181 Dim rng As Range, e Set Lista = Range("lstProdutos") With Me .ListBox1.Clear For Each i In Lista.Value If (i <> "") * (i Like "*" & .TextBox1.Value & "*") Then .ListBox1.AddItem i End If Next i End With End If End Sub '3)Aceptar el valor elegido y capturarlo en la celda activa Private Sub CommandButton2_Click() Cuenta = Me.ListBox1.ListCount For i = 0 To Cuenta - 1 If Me.ListBox1.Selected(i) = True Then ActiveCell.Value = Me.ListBox1.List(i) End If Next i Unload Me End Sub '4)Cerrar el formulario Private Sub CommandButton1_Click() Unload Me End Sub Private Sub Listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) With Me.ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then ActiveCell.Value = .List(i, 0) Exit For End If Next End With Unload Me End Sub -----Modulo-------- Private Sub Listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) With Me.ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then Me.TextBox1.Value = .List(i, 0) Exit For End If Next End With End Sub