VBA Powerpoint - Exportando os Títulos dos Slides e seus respectivos Números das páginas - Export Slide Number and Title Text to a text file

| Blog Office VBA | Blog Excel | Blog Access |

Imagine poder, no meio da apresentação, digitar o número do Slide para o qual deseja saltar e o MS Powerpoint salta para este slide cujo o número foi digitado. Explêndido!

Apenas precisará saber qual é o número do slide onde está a citação que deseja fazer. Quem se lembra onde está? Ninguém?

Por isso, talvez queira executar esse código pouco antes de efetuar a apresentação. Ele coleta o título dos Slides, bem como os seus respectivos números  e os salva em um arquivo que você possa imprimir. 

Agora, quando alguém começar a perguntar sobre determinado tópico da sua apresentação poderá consultar rapidamente a sua lista e ir direto para o slide correto.

Sub GatherTitles()

On Error GoTo ErrorHandlerDim oSlide As SlideDim strTitles As StringDim strFilename As StringDim intFileNum As IntegerDim PathSep as String If ActivePresentation.Path = "" Then    MsgBox "Please save the presentation then try again"    Exit SubEnd If#If Mac Then    PathSep = ":"#Else    PathSep = "\"#End IfOn Error Resume Next ' in case there's no title placeholder on the slideFor Each oSlide In ActiveWindow.Presentation.Slides    strTitles = strTitles _        & "Slide: " _        & CStr(oSlide.SlideIndex) & vbCrLf _        & oSlide.Shapes.Title.TextFrame.TextRange.Text _        & vbCrLf & vbCrLfNext oSlideOn Error GoTo ErrorHandlerintFileNum = FreeFile ' PC-Centricity Alert!' This assumes that the file has a .PPT extension and strips it off to make the text file name.strFilename = ActivePresentation.Path _    & PathSep _    & Mid$(ActivePresentation.Name, 1, Len(ActivePresentation.Name) - 4) _    & "_Titles.TXT"Open strFilename For Output As intFileNumPrint #intFileNum, strTitlesNormalExit:Close intFileNumExit SubErrorHandler:MsgBox Err.DescriptionResume NormalExit

End Sub

Tags: VBA, Powerpoint, title,text,slide number,slide index,go to,extract,outline 

VBA Access - Colocando título na sua aplicação.

Termo de Responsabilidade 

Mostre que suas aplicações MS Access são organizadas por inserir no título delas um texto que demonstre:

- O nome da aplicação

- A ação efetuada no momento por sua aplicação

- O nome da sua empresa

- Código do processamento sendo efetuado no momento.

Pode usar a funcionalidade para inúmeras coisas, aproveite!

Option Explicit

Option Compare Database

Private Declare Function

 SetWindowText _

Lib "user32" _

Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Public Sub SetFormTitle(frm As Form, TitleText As String)

Dim fhWnd As Long

Let fhWnd = frm.hwnd

SetWindowText fhWnd, TitleText

End Sub

'Copie a SUB abaixo dentro do formulário, no evento OnOpen.

Private Sub Form_Open(Cancel As Integer)

SetFormTitle Me, ".: A&A - In Any Place - Título da minha aplicação!"

End Sub

Referências: 

Tags: VBA, Access, application, title, título, aplicação, 

VBA Access - Número de linhas de código na aplicação

Termo de Responsabilidade 

Este é o típico artigo de MS Access voltado para o desenvolvedor. Como contar o Nº de linhas de código?

O código abaixo retornará o número de linhas de código contidas na sua aplicação de banco de dados corrente. Contará do início do seu primeiro módulo até as linhas de código existentes nos seus formulários e relatórios. Opcionalmente poderá listar o número das linhas em cada módulo e/ou obter o resumo numérico para cada tipo de módulo.

Para usar o código na sua aplicação, crie um novo módulo, e cole este código abaixo nele:

Option Compare Database
Option Explicit

'Purpose: Count the number of lines of code in your database.

Private Const micVerboseSummary = 1

Private Const micVerboseListAll = 2

Public Function CountLines(Optional iVerboseLevel As Integer = 3) As Long
On Error GoTo Err_Handler

'Purpose: Count the number of lines of code in modules of current database.

'Requires: Access 2000 or later.
'Argument: This number is a bit field, indicating what should print to the Immediate Window:

' 0 displays nothing
' 1 displays a summary for the module type (form, report, stand-alone.)

' 2 list the lines in each module
' 3 displays the summary and the list of modules.

'Notes: Code will error if dirty (i.e. the project is not compiled and saved.)

' Just click Ok if a form/report is assigned to a non-existent printer.

' Side effect: all modules behind forms and reports will be closed.

' Code window will flash, since modules cannot be opened hidden.


Dim accObj As AccessObject 'Cada módulo/formulário/relatório.
Dim strDoc As String 'Nome de cada formulário/relatório.

Dim lngObjectCount As Long 'Número dos módulos/formulários/relatórios
Dim lngObjectTotal As Long 'Total do número de objetos.

Dim lngLineCount As Long 'Número de linhas por tipo de objeto.
Dim lngLineTotal As Long 'Total do número de linhas para todos os tipos de objetos.

Dim bWasOpen As Boolean 'Flag para indicar se formulário/relatório está aberto ou foi aberto.

'Módulo de espera.

Let lngObjectCount = 0&
Let lngLineCount = 0&

For Each accObj In CurrentProject.AllModules
'OPTIONAL: TO EXCLUDE THE CODE IN THIS MODULE FROM THE COUNT:

' a) Uncomment the If ... and End If lines (3 lines later), by removing the single-quote.
' b) Replace MODULE_NAME with the name of the module you saved this in (e.g. "Module1")
' c) Check that the code compiles after your changes (Compile on Debug menu.)

'If accObj.Name <> "MODULE_NAME" Then

Let lngObjectCount = lngObjectCount + 1&
Let lngLineCount = lngLineCount + GetModuleLines(accObj.Name, True, iVerboseLevel)

'End If
Next

Let lngLineTotal = lngLineTotal + lngLineCount

Let lngObjectTotal = lngObjectTotal + lngObjectCount

If (iVerboseLevel And micVerboseSummary) <> 0 Then
Debug.Print lngLineCount & " line(s) in " & lngObjectCount & " stand-alone module(s)"

Debug.Print
End If

' Módulos dentro do formulários.
Let lngObjectCount = 0&

Let lngLineCount = 0&

For Each accObj In CurrentProject.AllForms
Let strDoc = accObj.Name

Let bWasOpen = accObj.IsLoaded

If Not bWasOpen Then
DoCmd.OpenForm strDoc, acDesign, WindowMode:=acHidden
End If


If Forms(strDoc).HasModule Then
Let lngObjectCount = lngObjectCount + 1&
Let lngLineCount = lngLineCount + GetModuleLines("Form_" & strDoc, False, iVerboseLevel)

End If

If Not bWasOpen Then
DoCmd.Close acForm, strDoc, acSaveNo
End If
Next

Let lngLineTotal = lngLineTotal + lngLineCount

Let lngObjectTotal = lngObjectTotal + lngObjectCount

If (iVerboseLevel And micVerboseSummary) <> 0 Then
Debug.Print lngLineCount & " line(s) in " & lngObjectCount & " module(s) behind forms"

Debug.Print
End If

'Módulos dentro dos relatórios.
Let lngObjectCount = 0&

Let lngLineCount = 0&

For Each accObj In CurrentProject.AllReports
Let strDoc = accObj.Name

Let bWasOpen = accObj.IsLoaded

If Not bWasOpen Then
'na versão Access 2000, remova o parâmetro ", WindowMode:=acHidden" da linha abaixo.

DoCmd.OpenReport strDoc, acDesign, WindowMode:=acHidden
End If

If Reports(strDoc).HasModule Then
Let lngObjectCount = lngObjectCount + 1&

Let lngLineCount = lngLineCount + GetModuleLines("Report_" & strDoc, False, iVerboseLevel)
End If

If Not bWasOpen Then

DoCmd.Close acReport, strDoc, acSaveNo
End If
Next

Let lngLineTotal = lngLineTotal + lngLineCount
Let lngObjectTotal = lngObjectTotal + lngObjectCount


If (iVerboseLevel And micVerboseSummary) <> 0 Then
Debug.Print lngLineCount & " linha(s) no(s) " & lngObjectCount & " módulo(s) dentro do(s) relatório(s)"
Debug.Print lngLineTotal & " linha(s) no(s) " & lngObjectTotal & " módulo(s)"

End If

Let CountLines = lngLineTotal

Exit_Handler:
Exit Function

Err_Handler:
Select Case Err.Number


Case 29068& 'Este erro ocorre atualmente em GetModuleLines()
MsgBox "Não posso completar a operação." & vbCrLf & "Certifique-se de que o código tenha sido previamente Compilado e Salvo."

Case Else
MsgBox "Erro: " & Err.Number & " - " & Err.Description
End Select

Resume Exit_Handler
End Function

Private Function GetModuleLines(strModule As String, bIsStandAlone As Boolean, iVerboseLevel As Integer) As Long

'Usage: Evocada por CountLines().
'Note: Do not use error handling: must pass error back to parent routine.


Dim bWasOpen As Boolean 'Flag aplicado somente para módulos standalone.


If bIsStandAlone Then
Let bWasOpen = CurrentProject.AllModules(strModule).IsLoaded
End If


If Not bWasOpen Then
DoCmd.OpenModule strModule
End If

If (iVerboseLevel And micVerboseListAll) <> 0 Then
Debug.Print Modules(strModule).CountOfLines, strModule
End If


Let GetModuleLines = Modules(strModule).CountOfLines

If Not bWasOpen Then
DoCmd.Close acModule, strModule, acSaveYes
End If
End Function

Referências:   Allen Browne

Tags: VBA, Excel, chart, title, serie