VBA Word - Exportando o conteúdo de um .DOC para um Slide .PPT

Termo de Responsabilidade

Isso é que chamo uma excelente oportunidade de economizar tempo. Exporte o conteúdo do seu documento MS Word para slides do MS Powerpoint.


A ação abaixo ocorrerá basicamente num único passo:

Copie este código num módulo do documento MS Word.

Abra o documento com o conteúdo que deseja exportar e execute o código.

Sub ExportEmbeddedSlidesAsPresentation()
Dim i As Integer
Dim nPresentation As Object
Dim nDocument As Document
Set nDocument = ActiveDocument
For i = 1 To nDocument.InlineShapes.Count
If nDocument.InlineShapes(i).Type = wdInlineShapeEmbeddedOLEObject Then
If nDocument.InlineShapes(i).OLEFormat.ProgID = "PowerPoint.Slide.8" Then
nDocument.InlineShapes(i).OLEFormat.DoVerb 2
Set nPresentation = CreateObject("PowerPoint.Application")
Call nPresentation.presentations(nPresentation.presentations.Count) _ .SaveCopyAs("C:\tmp\InAnyPlaceSlide" & i & ".ppt")
nPresentation.presentations (nPresentation.presentations.Count).Close End If
End If
Next i
 nPresentation.Quit
 Set nPresentation = Nothing
 End Sub

 

Tags: VBA, Word, Powerpoint, export, slide

VBA Word - Retire todos hyperlinks mantendo o texto no .DOC

Termo de Responsabilidade

Não raro recebemos e/ou baixamos documentos do MS Word repleto de links que somente nos irritam tamanho número de links no seu interior.


Abaixo segue a solução para retirá-los, preservando o texto.

Sub EjectLinks()Dim nRange As Range

For Each nRange In ActiveDocument.StoryRanges
Do While nRange.Hyperlinks.Count & nRange.Hyperlinks(1).Delete
Loop
Next nRange
End Sub

Tags: VBA, Word, hyperlinks

Excel VBA – Solução eficiente para deletar milhares de linhas

Termo de Responsabilidade

Caso necessite deletar aquelas planilhas com milhares de linhas em branco poderá usar a funcionalidade abaixo.

Function EliminateThousandBlankLines (StarLine as Long)
' Author: André Luiz Bernardes.
' Date: 05.02.2009
  Let nRow = StartLine
  Do While ActiveSheet.Cells(nRow, 1) <> ""
If ActiveSheet.Cells(nRow, 1).Value <> strUserName Then ActiveSheet.Rows(nRow).EntireRow.Delete
Else
Let nRow = nRow + 1
End If
Loop
 End Function

Tags: VBA, Excel, row, line, delete

MS Excel - Deletando linhas - 07 – Linhas duplicadas - Delete duplicate rows

Termo de Responsabilidade

Olá novamente... Vez por outra colamos bases de dados no MS Excel para análise e sem que nos apercebamos dados duplicados acabam ficando juntos em nosso range.

Como efetuar uma depuração que retire as ocorrências duplicadas deixando somente uma versão de cada registro?

Pois bem, a solução abaixo é o resultado de tal necessidade. Implementem, deixem o crédito para quem desenvolveu e tudo estará bem.

Public Sub DelDupliRows (rng As Range)

' Author: Date: Contact:

' André Bernardes 29/01/2009 12:18 bernardess@gmail.com

' Esta SUB deletará registros (linhas) duplicadas, será baseada no Range passado

' como parâmetro. Quando esta SUB achar mais duma ocorrência no mesmo Range,

' todas as ocorrências seguintes serão deletadas.

Dim r As Long

Dim n As Long

Dim v As Variant

On Error GoTo EndMacro

Let Application.ScreenUpdating = False

Let Application.Calculation = xlCalculationManual

Let Application.StatusBar = "Linha sendo processada: " & _ 
Format(rng.Row, "#,##0")

Let n = 0

For r = rng.Rows.Count To 2 Step -1

If r Mod 500 = 0 Then

Let Application.StatusBar = "Processing Row: " & Format(r, "#,##0")

End If

Let v = rng.Cells(r, 1).Value

If v = vbNullString Then

If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then

rng.Rows(r).EntireRow.Delete

Let n = n + 1

End If

Else

If Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Then

rng.Rows(r).EntireRow.Delete

Let n = n + 1

End If

End If

Next r

EndMacro:

Let Application.StatusBar = False

Let Application.ScreenUpdating = True

Let Application.Calculation = xlCalculationAutomatic

MsgBox CStr(n) & "Linha(s) Duplicada(s) Deleta(s) "

End Sub

Tags: Excel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines, duplicate, duplicado, dados, paste, cut

André Luiz Bernardes

A&A® - In Any Place.

MS Excel – Máscara para CNPJ

| Blog Office VBA | Blog Excel | Blog Access |

100.000 VISITAS

Como sabem, sempre precisamos nos lembrar dos campos tão tipicamente brasileiros para o preenchimento de cadastros.

O CNPJ não foge a regra, sempre necessitamos preparar o campo que receberá o seu conteúdo.

Abaixo uma pequena SUB que força o preenchimento de acordo com a máscara desejada.

Function CNPJFormat() as String

Let CNPJFormat = Format([Campo], "00"".""000"".""000""/""0000""-""00") 

End Sub

Futuramente disponibilizo o modo de check quanto aos cálculos do mesmo, isso sim, muito mais interessantes.

Tags: VBA, Excel, CNPJ, format, máscara,