Midori
-
Posts
3.602 -
Cadastrado em
-
Última visita
Tópicos solucionados
-
O post de Midori em Planilha Colunas Maiúsculas Módulo VBA foi marcado como solução
A sintaxe da função é: Format(Expression, [ Format ], [ FirstDayOfWeek ], [ FirstWeekOfYear ])
O primeiro parametro é obrigatório e deve receber a expressão que será formatada no retorno da função. No seu caso é a data. Você deve passar a data como argumento e aplicar o formato no segundo parametro, p.ex:
Resultado.Value = "PDD CANCEL " & Format(PedidoDia.Value, "DD/MM/YY") & " C/DVL
-
O post de Midori em Qual o melhor formato de arquivo excel para o excel 2003? foi marcado como solução
O formato é o que está lá no salvar como xls Excel-97-2003.
No caso de incompatibilidade de algum recurso o Excel mostra um alerta antes.
-
O post de Midori em Exel - Somar valores por títular comum foi marcado como solução
O modo mais simples é com tabela dinâmica. Selecione a tabela e arraste os campos para agrupar.
-
O post de Midori em Identificar disciplinas das turmas por determinada semana foi marcado como solução
Cole na célula B6, veja se resolve.
=PARALIN(SE(DESLOC(INDIRETO("Matriz!"&SEERRO(ENDEREÇO(CORRESP($B$3;Matriz!$B:$B;0);COL(Matriz!$B:$B));ENDEREÇO(CORRESP($B$3;Matriz!$I:$I;0);COL(Matriz!$I:$I))));2;0;5;5)=C4;{"LINGUA PORTUGUESA";"MATEMATICA";"CIENCIAS";"HISTORIA";"DESENHO"};NÃO.DISP());3;VERDADEIRO)
-
O post de Midori em Associando letra ao número correspondente. foi marcado como solução
O código fica assim,
Sub MacroCodigo() Dim Palavra As String Dim Codigo As String Dim L As Integer Palavra = UCase(Trim([A1].Value)) For L = 1 To Len(Palavra) Codigo = Codigo & " " & Asc(Mid(Palavra, L, 1)) - Asc("A") + 1 Next L [A2].Value = LTrim(Codigo) End Sub
-
O post de Midori em alternando a mensagem mensal foi marcado como solução
Outra forma com o mesmo conceito e sem a função Mod é com a aplicação do teorema da divisão,
dividendo = quociente * divisor + resto
Onde quociente é a parte inteira de dividendo/divisor. Portanto,
resto = dividendo - dividendo/divisor * divisor
A fórmula fica: =SE(MÊS(A1)-TRUNCAR(MÊS(A1)/2)*2;"SIM";"não")
-
O post de Midori em Macro com condição para não enviar e-mail de alerta em duplicidade foi marcado como solução
No seu loop a partir de ActiveCell a coluna G fica 3 colunas a direita. Então é só preencher lá quando acontecer o envio e fazer uma condição para enviar apenas quando não tiver nada na célua, p.ex,
If ActiveCell.Offset(0, 3).Value <> "ENVIADO" Then ... ActiveCell.Offset(0, 3).Value = "ENVIADO" End If
-
O post de Midori em Preciso vincular um valor de uma célula para outra célula no Google Sheets foi marcado como solução
No menu Insert tem o Dropdown. Adicione na célula com a configuração Dropdown from range e selecione a lista de pedidos. Na coluna valor aplique vlookup/procv com o retorno da coluna D da aba Dados.
-
O post de Midori em Anexar mais de um arquivo na mesma mensagem (VBA: Excel + Outlook) foi marcado como solução
Não precisa. Basta passar a variável com Split como já fez.
É isso que a macro espera, o caminho do(s) arquivo(s) na coluna O. Só os nomes, sem colchetes, separados por ponto e vírgula.
-
O post de Midori em Consulta com ListBox Condicional foi marcado como solução
Sem a função Unique pode ser feito com AddItem mesmo.
Para adicionar os elementos no list, fiz o procedimento AdicionaItem com um teste para não pegar item repetido, veja se assim resolve,
Option Explicit Private TabelaExtrato As ListObject Private Sub UserForm_Initialize() Set TabelaExtrato = ThisWorkbook.Worksheets("Extrato").[tb_Extrato].ListObject If Not TabelaExtrato.DataBodyRange Is Nothing Then listLancamentos.ColumnWidths = "0;0;60;0;0;0;0;0;0;80;100" listLancamentos.ColumnCount = TabelaExtrato.DataBodyRange.Columns.Count listLancamentos.List() = TabelaExtrato.DataBodyRange.Value Call AdicionaItem(listSituacao, TabelaExtrato, "Situação") Call AdicionaItem(listCategoria, TabelaExtrato, "Categoria") Call AdicionaItem(listSubcategoria, TabelaExtrato, "SubCategoria") End If End Sub Private Sub listLancamentos_Click() If listLancamentos.ListIndex >= 0 Then Dim Id As Integer Id = listLancamentos.List(listLancamentos.ListIndex, 0) txtData.Value = BuscaRegistro(TabelaExtrato, Id, "Data") txtId.Value = BuscaRegistro(TabelaExtrato, Id, "Id") txtValor.Value = BuscaRegistro(TabelaExtrato, Id, "Valor") txtVencimento.Value = BuscaRegistro(TabelaExtrato, Id, "Vencimento") End If End Sub Function BuscaRegistro(Tabela As ListObject, Id As Integer, NomeColuna As String) As String Dim intColuna As Integer Dim intId As Integer Dim Linha As Long intColuna = Tabela.ListColumns(NomeColuna).Index intId = Tabela.ListColumns("Id").Index If Not Tabela.DataBodyRange Is Nothing Then If WorksheetFunction.CountIf(Tabela.DataBodyRange.Columns(intId), Id) > 0 Then Linha = WorksheetFunction.Match(Id, Tabela.DataBodyRange.Columns(intId), 0) BuscaRegistro = Tabela.DataBodyRange(Linha, intColuna).Value End If End If End Function Sub AdicionaItem(Controle As Object, Tabela As ListObject, NomeColuna As String) If Not Tabela.DataBodyRange Is Nothing Then Dim intColuna As Integer Dim Linha As Long intColuna = Tabela.ListColumns(NomeColuna).Index For Linha = 1 To Tabela.DataBodyRange.Rows.Count If WorksheetFunction.CountIf( _ Tabela.DataBodyRange(1, intColuna).Resize(Linha), _ Tabela.DataBodyRange(Linha, intColuna)) < 2 Then Call Controle.AddItem(Tabela.DataBodyRange(Linha, intColuna).Value) End If Next Linha End If End Sub
-
O post de Midori em Macro para auto-preenchimento "copiar dados de coluna p/ uma tabela na vertical" foi marcado como solução
O código completo,
Sub PreencheQuadro() Dim Area As Range Dim Quadro As Range Dim Lin As Long Dim L As Long Dim C As Integer Dim Col As Integer Set Area = [D11:AL17] Set Quadro = [BC10:BK17] L = Quadro.Rows.Count C = Quadro.Columns.Count For Col = 1 To Area.Columns.Count For Lin = 1 To Area.Rows.Count If Area(Lin, Col).Value <> "" Then Quadro(L, C).Value = Area(Lin, Col).Value C = C - 1 If C Mod Quadro.Columns(1).Column = 0 Then L = L - 1 C = Quadro.Columns.Count End If End If Next Lin Next Col End Sub
-
O post de Midori em Escolher arquivo antes de envia e-mail VBA foi marcado como solução
Assim é para o VBA do Outlook. Para o Excel a atribuição é como está lá no link que comentei.
***
Uma forma mais simples que fiz aqui foi atribuindo Item de MailEnvelope ao MailItem do Outlook (por isso a referência ao objeto deve estar selecionada),
Sub MacroEmail() Dim Email As MailItem Dim Dialogo As FileDialog Dim Anexo As Variant Set Email = ThisWorkbook.Sheets("Teste").MailEnvelope.Item Set Dialogo = Application.FileDialog(msoFileDialogFilePicker) Dialogo.AllowMultiSelect = True If Dialogo.Show <> 0 Then For Each Anexo In Dialogo.SelectedItems Call Email.Attachments.Add(Anexo) Next Anexo End If Email.To = "" Email.Subject = "Teste" Email.Send End Sub
Assim vai a planilha no corpo do email com o anexo selecionado no diálogo.
Pode acontecer uma falha em MailEnvelope, para resolver isso é só salvar a planilha.
-
O post de Midori em Submenu no Userform para abrir as planilhas foi marcado como solução
É possível substituir. Para isso os Buttons serão adicionados dinâmicamente já que para cada aba vai ter um botão.
Dependendo da quantidade de abas não vejo vantagem nisso já que o Form vai ficar com muitos controles. Com o Combo basta um com a lista para seleção.
-
O post de Midori em Execução automática de macro vba foi marcado como solução
Assim o procedimento está errado, para esse evento o VBA espera o parâmentro Range. Esta é a forma correta: Worksheet_Change(ByVal Target As Range)
Change será ativado em resposta a edição de alguma célula. E se o texto de A1 for "vermelho" a macro colore A1:Z1.
-
O post de Midori em Beep no VBA alterando a frequência e duração foi marcado como solução
@Jeff_Sandes Você pode referenciar Beep com esta declaração,
Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Aí é só chamar a função no procedimento com os argumentos da frequência e duração.
-
O post de Midori em VBA - ComboBox com Item fixo foi marcado como solução
Depois de adicionar os anos é só fazer a atribuição no Initialize: cb_Procurar.Value = 2024
-
O post de Midori em Macro copia e cola PDF a partir da busca de uma lista foi marcado como solução
Veja se assim resolve,
Sub CopiaArquivos() Dim Dialogo As FileDialog Dim Area As Range Dim Nome As Range Dim TermoNE As Range Dim DirOrig As String Dim DirDest As String Dim Arquivo As String Set Area = [A2:A30] Set TermoNE = [E2] Set Dialogo = Application.FileDialog(msoFileDialogFolderPicker) Dialogo.Title = "Origem" Dialogo.Show If Dialogo.SelectedItems.Count = 1 Then DirOrig = Dialogo.SelectedItems(1) Dialogo.Title = "Destino" Dialogo.Show If Dialogo.SelectedItems.Count = 1 Then DirDest = Dialogo.SelectedItems(1) If DirOrig <> "" And DirDest <> "" Then For Each Nome In Area Arquivo = DirOrig & "\" & Trim(Nome.Value) & ".pdf" If Dir(Arquivo) <> "" Then Call FileCopy(Arquivo, DirDest & "\" & Trim(Nome.Value) & ".pdf") Else TermoNE.Value = Nome.Value Set TermoNE = TermoNE(2) End If Next Nome Else MsgBox "Diretório(s) inválido(s)", vbExclamation End If End Sub
-
O post de Midori em Formula Excel 100% para validação premio foi marcado como solução
Se for no excel 365 você pode usar a fórmula ORDEM.EQ,
=SEERRO(ÍNDICE($N$8:$N$14;ORDEM.EQ(K8;$K$8:$K$19));0)
-
O post de Midori em Destacar células alternadas/diferentes com formatação condicional foi marcado como solução
Se a sua versão for a 365 poderá usar a fórmula ÚNICO e fazer assim,
=MOD(CORRESP(A1;ÚNICO($A$1:$A$13);0);2)
Dessa forma poderá usar a posição dos dados encontrados no array e aplicar a formatação nas posições ímpares.
-
O post de Midori em Como salvar em planilha selecionada por combobox de um userform foi marcado como solução
@Lucia Andrade A condição deve ser >= 0. Corrigi isso no código pouco depois (estava > 0).
-
O post de Midori em Erro em Código VBAWord - Aplicar Ajuste de Janela em todas as tabelas de um Doc foi marcado como solução
@Ewerton de Miranda Não precisa selecionar a tabela, veja se o loop assim resolve,
For a = 1 To qtd_tabelas Call doc.Tables(a).AutoFitBehavior(wdAutoFitWindow) Next a
-
O post de Midori em Como adicionar opções numa ComboBox foi marcado como solução
Os elementos são acrescentados no combo com o procedimento AddItem. É só fazer um para cada no Initialize do formulário.
-
O post de Midori em Fórmula Excel Com Dados Variáveis na Coluna foi marcado como solução
Veja se assim resolve,
=SOMA((Tabela1[SITUAÇÃO]>="D")*(Tabela1[SITUAÇÃO]<="H")*(NÚM.CARACT(Tabela1[SITUAÇÃO])=1)*SUBTOTAL(9;DESLOC(C10;LIN(Tabela1[VALOR])-LIN(C10);0)))
-
O post de Midori em Output diferente do input foi marcado como solução
Talvez a plataforma esteja recebendo a formatação da célula. Tenta deixar o range como texto para ver se resolve NumberFormat = "@".
-
O post de Midori em UserForm para coleta de dados foi marcado como solução
É só pegar o primeiro código, que funciona, e acrescentar a atribuição que comentei no meu segundo post.
Sobre o Clube do Hardware
No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais
Direitos autorais
Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais