Macro para maiúscula em nome próprio

Bom dia,
A tempos atrás, baixei uma macro, mas precisamente uma extensão criada por NOELSON A. DUARTE, para transformar a 1º letra de cada palavra em maiúscula, mas este macro ou extensão somente é para uso nas planilhas…
Gostaria de saber se tem como alterar o comando para que seja usado para o writer…
segue em anexo a estrutura da extensão…

Sub ConverterLetrasIniciais
    oDoc = thisComponent
    oSelec = oDoc.getCurrentSelection()
    ' celula ou intervalo selecionado ?
    If (Not oSelec.supportsService("com.sun.star.sheet.SheetCellRange")) Then
        MsgBox "Selecione a célula ou o intervalo de células!", 48, "Erro"
        Exit Sub
    End If
    ' cria e exibe uma caixa de diálogo
    DialogLibraries.loadLibrary ( "TamLetra" )
    oDialogo = CreateUNODialog (DialogLibraries.TamLetra.Dialog1)
    iResp = oDialogo.execute()
    ' usuário cancelou ? encerra
    If iResp = 0 Then
        Exit Sub
    End If
    ' verifica estado da caixa de seleção
    bMinusc = False
    If oDialogo.Model.CheckBox1.State = 1 Then
        bMinusc = True
    End If
    ' verifica estado do botão de opção
    bNome = False
    If oDialogo.Model.OptionButton2.State = 1 Then
        bNome = True
    End If
    ' inicia a conversão
    LetrasIniciaisMaiusculas (oSelec, bNome, bMinusc)
End Sub

'_____________________________________________________________________________________________

Sub LetrasIniciaisMaiusculas (oSel As Variant, bNomeProprio As Boolean, bMinuscula As Boolean)
    ' obtem limites da seleção
    vEnd = oSel.getRangeAddress()
    nrLinhas = vEnd.EndRow - vEnd.StartRow
    nrColunas = vEnd.EndColumn - vEnd.StartColumn
    tipoTexto = com.sun.star.table.CellContentType.TEXT
    ' percorre as células selecionadas
    For i = 0 To nrLinhas
        For j = 0 To nrColunas
            oCelula = oSel.getCellByPosition(j, i)
            ' apenas células com texto nos interessa
            If oCelula.getType() = tipoTexto Then
                sConteudo = oCelula.getString()
                If bMinuscula Then
                    ' converte as letras em minúsculas
                    sConteudo = LCase(sConteudo)
                End If
                If bNomeProprio Then
                    ' converte no estilo de nomes próprios
                    novoCont = LetrasNomeProprio(sConteudo)
                Else
                    ' converte todas as iniciais para maiúsculas
                    novoCont = TodasIniciaisMaiusculas(sConteudo)
                End If
                ' atualiza o conteúdo da célula
                oCelula.setString(novoCont)
            End If
        Next j
    Next i
End Sub

'___________________________________________________

Function TodasIniciaisMaiusculas (sCadeia) As String
    vPalavras = Split (sCadeia)
    For i = 0 To UBound(vPalavras)
        letra = UCase(Left$(vPalavras(i),1))
        Mid(vPalavras(i), 1, 1, letra)
    Next i
    TodasIniciaisMaiusculas = Join(vPalavras())
End Function

Se tiver uma idéia para alterar este macro serei grato…

se tem com ser uma texto selecionado …

Se o objetivo for colocar as palavras do texto no writer com a inicial em maiúsculas, existe um comando para isso em Formatar - Texto - Palavras Iniciando Com Maiúsculas.

Boa tarde,

Modifiquei as duas subrotinas para funcionar no Writer. As funções que você forneceu permanecem iguais.

Não estou muito familiarizado com os objetos do Writer como estou com os do Calc. Por isso, posso apenas tentar uma aproximação. Ela funcionou para o texto selecionado, mesmo que em linhas (parágrafos) diferentes.

Sub ConverterLetrasIniciais
   oDoc = thisComponent
   oSelec = oDoc.getCurrentSelection()
   ' sair se a seleção não for a um intervalo de texto
   If oSelec.ImplementationName <> "SwXTextRanges" Then Exit Sub
   ' cria e exibe uma caixa de diálogo
   DialogLibraries.loadLibrary ( "TamLetra" )
   oDialogo = CreateUNODialog (DialogLibraries.TamLetra.Dialog1)
   iResp = oDialogo.execute()
   ' usuário cancelou ? encerra
   If iResp = 0 Then
       Exit Sub
   End If
   ' verifica estado da caixa de seleção
   bMinusc = False
   If oDialogo.Model.CheckBox1.State = 1 Then
       bMinusc = True
   End If
   ' verifica estado do botão de opção
   bNome = False
   If oDialogo.Model.OptionButton2.State = 1 Then
       bNome = True
   End If
   ' inicia a conversão
   LetrasIniciaisMaiusculas (oSelec, bNome, bMinusc)
End Sub

Sub LetrasIniciaisMaiusculas (oSel As Variant, bNomeProprio As Boolean, bMinuscula As Boolean)
   ' O texto da seleção
   oTexto = oSel.getByIndex(0)
   sConteudo = oTexto.getString()
   If bMinuscula Then
   ' converte as letras em minúsculas
     sConteudo = LCase(sConteudo)
   End If
   If bNomeProprio Then
   ' converte no estilo de nomes próprios
     novoCont = LetrasNomeProprio(sConteudo)
   Else
   ' converte todas as iniciais para maiúsculas
     novoCont = TodasIniciaisMaiusculas(sConteudo)
   End If
   ' atualiza o texto da seleção
   oTexto.setString(novoCont)
End Sub

Atte,

1 Like

Bom dia Grafeno, então a função abaixo (LetrasNomeProprio) não há necessidade de ser alterado para ser usado no writer???

Boa tarde! Não é preciso alterar a função LetrasNomeProprio e nem a função TodasIniciaisMaiusculas. Elas não interagem com qualquer objeto e por isso não precisam ser “traduzidas” do Calc para o Writer.

Ficou ok. mas aos exportar para extensão dá esta mensagem:(com.sun.star.deployment.DeploymentException) { { Message = “Ocorreu um erro ao ativar: NomeProprio”, Context = (com.sun.star.uno.XInterface) @6942960 }, Cause = (any) { (com.sun.star.lang.IllegalArgumentException) { { { Message = “”, Context = (com.sun.star.uno.XInterface) @0 } }, ArgumentPosition = (short) 0 } } }
Tem alguma solução…

segue link do arquivo criado para ser extensão

Olha o erro " Message = "Ocorreu um erro ao ativar: NomeProprio ". Seu arquivo não veio com a Biblioteca “NomeProprio” que contém o diálogo usado na extensão. Vc tem que importar esta biblioteca para o arquivo antes de distribui-lo.

Reenviando
Vincular texto

Agora acho que deu…

Vincular texto acho que agora deu…

Encontrei o erro: após criar a extensão é necessário apagar a biblioteca aonde foi criado…
contudo, mesmo adicionando a extensão ela não aparece no writer…
segue arquivo de extensão.
Vincular texto

Fico no aguardo se encontrar a solução…

Como colocar uma condição no Sub ConverterLetrasIniciais, para que se não selecionar o texto a ser alterado e não é um documento writer, ele dá um mensagem de erro. E estando o texto selecionado e sendo um documento writer ele ativa a caixa de diálogo. Pois dá dando erro no comando getByIndex(0), quando testo no calc.

@JorgeThomaz, após baixar e instalar a extensão que você disponibilizou, testei e funcionou perfeitamente no Writer, mas tive que ir em Ferramentas >> Macros >> Executar macro… >> Minhas macros > NomeProprio > Module1 > ConverterLetrasIniciais.

Na macro ConverterLetrasIniciais da minha resposta, se você observar, tem a linha If oSelec.ImplementationName <> “SwXTextRanges” Then Exit Sub que justamente evita a execução do código fora do Writer. Na extensão que você disponibilizou veio outra coisa. Atte,Grafeno.

Oi Grafeno quero lhe agradecer pela sua ajuda e do Gilberto e informar que consegui fazer uma extensão que está funcionando, não tem ícone na barra de ferramentas, mas tem menu e suplemento para acionar.
Se quiser posso lhe mandar para dar uma olhada , e se achar que está bom poderia colocar como extensão para os demais possam usar…

Oi @JorgeThomaz, tendo a dica do @ohallot, montei com o gravador de macro.

Com o texto selecionado.

sub IniciarPalavrasComMaiusculas
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:ChangeCaseToTitleCase", "", 0, Array())
end sub

Oi @Gilberto, contudo, este macro torna todas as iniciais de palavras em maiúsculas… O que preciso é um macro ou Function que apenas torne as palavras de nomes próprios em maiúsculas como o macro que enviei acima, ou seja, ao escrever manuel de souza ele deixa assim: Manuel de Souza como a extensão - macro - que enviei…Também gostaria de saber se posso transformar o macro em extensão para usar no writer, já que no calc já tem…

Oi @JorgeThomaz, como mencionou inicialmente “se tem com ser uma texto selecionado …” deduzi que selecionaria o texto necessário. Sobre a Function LetrasNomeProprio, desconheço se o Writer sabe quais são os Nomes Próprios. Uma saída não muito elegante seria cadastrar em Autocorreção, por exemplo: se digitar maria substituir por Maria. Será um cadastro um a um e sempre que houver Nomes Próprios novos, terá que incluir.

este macro ou função foi extraído do macro criado pelo Noelson A. Duarte, usando caixa de diálogo e transformando em extensão para ser usado no Calc. Contudo, eu queria alterar os comandos deste criação para ser adaptada ao writer já que o macro criado pelo noelson usa a célula selecionada para alteração de letra maiúscula para nome próprio. Assim, como o Writer é um processador de texto, a forma de selecionar seria através do cursor passando por cima da palavra para ser alterada…

Ou um macro para usar igual ao comando em Formatar - Texto - Alterar Caixa. Pois ele altera usando o cursor para selecionar…Ou um macro que não reconhece (“e”,“da”,“de”,“do”,“das”,“dos”) dos nomes próprios e automatizar como no tópico MACRO-IMPRIME E DELETA

Segue em anexo a function que faltou:

   Function LetrasNomeProprio (sCadeia) As String
        vExcluir = Array("e","da","de","do","das","dos")
        vPalavras = Split (sCadeia)
        For i = 0 To UBound(vPalavras)
            bExcluir = False
            For j = 0 To UBound(vExcluir)
                If LCase(vPalavras(i)) = vExcluir(j) Then
                    vPalavras(i) = LCase(vPalavras(i))
                    bExcluir = True
                    Exit For
                End If
            Next j
            If Not bExcluir Then
                letra = UCase(Left$(vPalavras(i),1))
                Mid(vPalavras(i), 1, 1, letra)
            End If
        Next i
        LetrasNomeProprio = Join(vPalavras())
    End Function

.