Ir ao conteúdo
  • Cadastre-se

Schiavinatto

Membro Pleno
 Perfil  Explorar Conteúdo

  • Posts

    150

  • Cadastrado em

  • Última visita

 Tipo de conteúdo 

posts postados por Schiavinatto

    Conversão de planilha com macro do office 2019 para libreoffice!

    em Microsoft Office e similares

    Postado

    Olá @fabio rodrigues, só consegui ver a macro de escrever o valor por extenso, tenho essa em Basic:

      

    ' Por Extenso	Function NExtenso(byval dValor as double) as string  
'https://wiki.documentfoundation.org/Extensions/Projects/NumExtenso/pt-br
'desenvolvida por: Noelson Alves Duarte e Gustavo Buzzatti Pacheco
'O############################################################################O
Function NExtenso(byval dValor as double) as string
'O############################################################################O
nextenso=extenso(dvalor,"reais", "real")
End function

Function Extenso(ByVal Valor As Double, ByVal MoedaPlural As String, ByVal MoedaSingular As String) As String
Dim StrValor As String, Negativo As Boolean
Dim Buf As String, Parcial As Integer
Dim Temp as string
Dim Posicao As Integer, Unidades
Dim Dezenas, Centenas, PotenciasSingular
Dim PotenciasPlural
Negativo = (Valor < 0)
Valor = Abs((Valor))
If Valor Then
Unidades = Array(vbNullString, "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove", "dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", "dezoito", "dezenove")
Dezenas = Array(vbNullString, vbNullString, "vinte", "trinta", "quarenta", "cinquenta", "sessenta", "setenta", "oitenta", "noventa")
Centenas = Array(vbNullString, "cento", "duzentos", "trezentos", "quatrocentos", "quinhentos", "seiscentos", "setecentos", "oitocentos", "novecentos")
PotenciasSingular = Array(vbNullString, " mil", " milhão", " bilhão", " trilhão", " quatrilhão")
PotenciasPlural = Array(vbNullString, " mil", " milhões", " bilhões", " trilhões", " quatrilhões")
StrValor = Left(Format(Valor, String(18, "0") & ".000"), 18)
For Posicao = 1 To 18 Step 3
Parcial = Val(Mid(StrValor, Posicao, 3))
If Parcial Then
If Parcial = 1 Then
Buf = "um" & PotenciasSingular((18 - Posicao) \ 3)
ElseIf Parcial = 100 Then
Buf = "cem" & PotenciasSingular((18 - Posicao) \ 3)
Else
Buf = Centenas(Parcial \ 100)
Parcial = Parcial Mod 100
If Parcial <> 0 And Buf <> vbNullString Then
Buf = Buf & " e "
End If
If Parcial < 20 Then
Buf = Buf & Unidades(Parcial)
Else
Buf = Buf & Dezenas(Parcial \ 10)
Parcial = Parcial Mod 10
If Parcial <> 0 And Buf <> vbNullString Then
Buf = Buf & " e "
End If
Buf = Buf & Unidades(Parcial)
End If
Buf = Buf & PotenciasPlural((18 - Posicao) \ 3)
End If
If Buf <> vbNullString Then
If Temp <> vbNullString Then
Parcial = Val(Mid(StrValor, Posicao, 3))
If Posicao = 16 And (Parcial < 100 Or _
(Parcial Mod 100) = 0) Then
Temp = Temp & " e "
Else
Temp = Temp & ", "
End If
End If
Temp = Temp & Buf
End If
End If
Next
If Temp <> vbNullString Then
If Negativo Then
Temp = "menos " & Temp
End If
If Int(Valor) = 1 Then
Temp = Temp & " " & MoedaSingular
Else
Temp = Temp & " " & MoedaPlural
End If
End If
Parcial = Int((Valor - Int(Valor)) * 100 + 0.1)
If Parcial Then
Buf = ExtensoCentavos(Parcial, "centavos", "centavo")
If Temp <> vbNullString Then
Temp = Temp & " e "
End If
Temp = Temp & Buf
End If
End If
Extenso = Temp
End Function

Function ExtensoCentavos(ByVal Valor As Double, ByVal MoedaPlural As String, ByVal MoedaSingular As String) As String
Dim StrValor As String, Negativo As Boolean
Dim Buf As String, Parcial As Integer
Dim Temp as string
Dim Posicao As Integer, Unidades
Dim Dezenas, Centenas, PotenciasSingular
Dim PotenciasPlural
Negativo = (Valor < 0)
Valor = Abs((Valor))
If Valor Then
Unidades = Array(vbNullString, "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove", "dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", "dezoito", "dezenove")
Dezenas = Array(vbNullString, vbNullString, "vinte", "trinta", "quarenta", "cinquenta", "sessenta", "setenta", "oitenta", "noventa")
Centenas = Array(vbNullString, "cento", "duzentos", "trezentos", "quatrocentos", "quinhentos", "seiscentos", "setecentos", "oitocentos", "novecentos")
PotenciasSingular = Array(vbNullString, " mil", " milhão", " bilhão", " trilhão", " quatrilhão")
PotenciasPlural = Array(vbNullString, " mil", " milhões", " bilhões", " trilhões", " quatrilhões")
StrValor = Left(Format(Valor, String(18, "0") & ".000"), 18)
For Posicao = 1 To 18 Step 3
Parcial = Val(Mid(StrValor, Posicao, 3))
If Parcial Then
If Parcial = 1 Then
Buf = "um" & PotenciasSingular((18 - Posicao) \ 3)
ElseIf Parcial = 100 Then
Buf = "cem" & PotenciasSingular((18 - Posicao) \ 3)
Else
Buf = Centenas(Parcial \ 100)
Parcial = Parcial Mod 100
If Parcial <> 0 And Buf <> vbNullString Then
Buf = Buf & " e "
End If
If Parcial < 20 Then
Buf = Buf & Unidades(Parcial)
Else
Buf = Buf & Dezenas(Parcial \ 10)
Parcial = Parcial Mod 10
If Parcial <> 0 And Buf <> vbNullString Then
Buf = Buf & " e "
End If
Buf = Buf & Unidades(Parcial)
End If
Buf = Buf & PotenciasPlural((18 - Posicao) \ 3)
End If
If Buf <> vbNullString Then
If Temp <> vbNullString Then
Parcial = Val(Mid(StrValor, Posicao, 3))
If Posicao = 16 And (Parcial < 100 Or _
(Parcial Mod 100) = 0) Then
Temp = Temp & " e "
Else
Temp = Temp & ", "
End If
End If
Temp = Temp & Buf
End If
End If
Next
If Temp <> vbNullString Then
If Negativo Then
Temp = "menos " & Temp
End If
If Int(Valor) = 1 Then
Temp = Temp & " " & MoedaSingular
Else
Temp = Temp & " " & MoedaPlural
End If
End If
Parcial = Int((Valor - Int(Valor)) * 100 + 0.1)
If Parcial Then
Buf = Extenso(Parcial, "centavos", "centavo")
If Temp <> vbNullString Then
Temp = Temp & " e "
End If
Temp = Temp & Buf
End If
End If
ExtensoCentavos = Temp
End Function

     

    • Curtir 1

    Relatório trimestral - índice e corresp

    em Microsoft Office e similares

    Postado

    @SkaterGirl

    10 horas atrás, SkaterGirl disse:

    @Schiavinatto

     

    Obrigada pela ajuda. Era realmente o que eu estava precisando. Se possível você poderia explicar a parte em negrito da fórmula? =SEERRO(ÍNDICE($DADOS.$C$2:$C$200;CORRESP(1;($DADOS.$D$2:$D$200=MENOR($DADOS.$D$2:$D$200;LINHA()-3));0));"")

     

    Gostaria de entender para poder usar em outras situações quando for necessário. 😀

     

    Sobre a parte negrito $DADOS.$D$2:$D$200 esta é a coluna onde é procurada a referência a parte =MENOR($DADOS.$D$2:$D$200;LINHA()-3  a funçãp menor requer um indice, o primeiro menor (1) que sera o primeiro da sequencia a ser localizado para não ser necessári alterr o 1 para 2 nas linhas seguintes uso a formula ;LINHA()-3

    9 horas atrás, SkaterGirl disse:

    Não querendo abusar, mas já abusando novamente...

     

    A fórmula funcionou certinho no LibreOffice Calc, conforme fui fazendo o preenchimento dos dados. Entretanto, quando importei a planilha para o Google Planilhas não funcionou (não mexi na fórmula). Alterei os trimestres no Google e não retornou as informações do "nº do processo". Como tem dias que trabalho em home office aí acabo utilizando as duas versões (no calc e no google). Seria necessário fazer alguma adaptação?

     

    Desconheço o funcionamento do Google Planilhas, só uso e desenvolvo para o LibreOffice, desde 1998 quando se chamava StarOffice.

     

    Sugestão, mantenha uma conta em uma nuvem ( ex: Dropbox / Mega ) com a pasta, dos arquivos, compartilhado nas maquinas, assim poderá usar o LibreOffice em todas as máquinas.

    • Amei 1

    vincular botão e fixar fórmula

    em Microsoft Office e similares

    Postado

    @pretojoia, segue versão com macros para lançamento de Entradas e Saídas.

     

    porém para o controle de Validade o Estoque também tem que controlar separado.

    Precisa estudar como será feito, para aprimorar a planilha.

     

    Caso queira entre em contato direto, e-mail em meu perfil, ao lado.

     

    ATENÇÃO O ARQUIVO ZIPADO ANEXO, SO ALTERE DE zip PARA ods, PARA ABERTURA NO LibreOffice.

    Planilha de control Estoque.zip

    vincular botão e fixar fórmula

    em Microsoft Office e similares

    Postado

    Ola @pretojoia, segue um exemplo do arquivo, posso te ajudar mais no final de semana...

     

    Na planilha ENTRADA, ao acionar o botão [Cadastrar] a macro copia os dados, sem formulas, para a planilha ENT_ESTOQUE e atualiza a Tabela Dinâmica que esta na planilha ESTOQUE_TD, para incluir novos itens, se necessário.

     

    Faça um teste, inclua um item novo, ele aparecerá na lista de ESTOQUE_TD.

     

    Caso queira tentar a replicar o processo para a SAIDA, fique a vontade ( ou posso faze-lo no final de semana )

     

    ATENÇÃO O ARQUIVO ZIPADO ANEXO, SO ALTERE DE zip PARA ods, PARA ABERTURA NO LibreOffice.

    Planilha de control Estoque.zip

    Função "SE" executando macro

    em Microsoft Office e similares

    Postado

    @LucianoAlexandre , acredito desta maneira não ser possível.

     

    Acredito que deva ser assim, estando com a célula A1 ativa, você aciona a macro, ela pega o texto da célula e com a condicional Case executa a macro desejada.

     

    Esta macro pode estar ligada em Eventos de planilha, assim será executada quando A1 sofrer alteração.

     

    De mais detalhes do uso desejado, se possível com um arquivo exemplo.

    Copiar a primeira célula acima com inforamção

    em Microsoft Office e similares

    Postado

    @Julio M. Abreu  segue macro corrigida:

     

    REM  *****  BASIC  *****

    sub XPTO
        GoToCel "B1"
    Dim oSel as Object
    Dim Var1 As integer
    Dim Var2 As Integer
    Dim Var3 As String
    oSel = ThisComponent.getCurrentSelection()
    Var1 = oSel.getString()

        For Var2 = 1 To Var1 Step 1
        Procurar
    Execute "Cut"
    Execute "GoDown"

    '====
    oSel = ThisComponent.getCurrentSelection()
    Var3 = oSel.getString()
        While Var3 <> ""  
    Execute "GoDown"
    oSel = ThisComponent.getCurrentSelection()
    Var3 = oSel.getString()
        Wend
        
    Execute "Paste"
    Execute "GoDown"
        Next
    End Sub


    '-----------------------
    '        SubMacros
    '-----------------------

    Sub Procurar
    dim args1(20) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "SearchItem.StyleFamily"
    args1(0).Value = 2
    args1(1).Name = "SearchItem.CellType"
    args1(1).Value = 0
    args1(2).Name = "SearchItem.RowDirection"
    args1(2).Value = true
    args1(3).Name = "SearchItem.AllTables"
    args1(3).Value = false
    args1(4).Name = "SearchItem.SearchFiltered"
    args1(4).Value = false
    args1(5).Name = "SearchItem.Backward"
    args1(5).Value = false
    args1(6).Name = "SearchItem.Pattern"
    args1(6).Value = false
    args1(7).Name = "SearchItem.Content"
    args1(7).Value = false
    args1(8).Name = "SearchItem.AsianOptions"
    args1(8).Value = false
    args1(9).Name = "SearchItem.AlgorithmType"
    args1(9).Value = 0
    args1(10).Name = "SearchItem.SearchFlags"
    args1(10).Value = 0
    args1(11).Name = "SearchItem.SearchString"
    args1(11).Value = "Conta"
    args1(12).Name = "SearchItem.ReplaceString"
    args1(12).Value = ""
    args1(13).Name = "SearchItem.Locale"
    args1(13).Value = 255
    args1(14).Name = "SearchItem.ChangedChars"
    args1(14).Value = 2
    args1(15).Name = "SearchItem.DeletedChars"
    args1(15).Value = 2
    args1(16).Name = "SearchItem.InsertedChars"
    args1(16).Value = 2
    args1(17).Name = "SearchItem.TransliterateFlags"
    args1(17).Value = 256
    args1(18).Name = "SearchItem.Command"
    args1(18).Value = 0
    args1(19).Name = "SearchItem.SearchFormatted"
    args1(19).Value = false
    args1(20).Name = "SearchItem.AlgorithmType2"
    args1(20).Value = 1
    createUnoService("com.sun.star.frame.DispatchHelper") _
    .executeDispatch(ThisComponent.CurrentController.Frame, ".uno:ExecuteSearch", "", 0, args1())
    End Sub


    Sub GoToCel ( xLocal$ )
    dim args1(0) as new com.sun.star.beans.PropertyValue : args1(0).Name = "ToPoint" : args1(0).Value = xLocal
    CreateUnoService("com.sun.star.frame.DispatchHelper") _
    .executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args1())
    End Sub


    Sub Execute ( oQe$ )
    CreateUnoService("com.sun.star.frame.DispatchHelper") _
    .executeDispatch(ThisComponent.CurrentController.Frame, ".uno:" & oQe & "", "", 0, Array())
    End Sub

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

Mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!