VBA Access: Exportando dados da query para Slides PPT

Exporte o conteúdo de suas queries diretamente para o MS Office Powerpoint.
Private Sub BtnExportData_Click() ' Author: Date: Contact: ' André Bernardes 28/05/2009 08:03 bernardess@gmail.com ' Dim db As Database, rs As Recordset Dim ppObj As PowerPoint.Application Dim ppPres As PowerPoint.Presentation Dim nQuery As String On Error GoTo err_cmdOLEPowerPoint Let nQuery = "qry_CHART" ' Open up a recordset on the Employees table. Set db = CurrentDb Set rs = db.OpenRecordset(nQuery, dbOpenDynaset) ' Open up an instance of Powerpoint. Set ppObj = New PowerPoint.Application Set ppPres = ppObj.Presentations.Add ' Setup the set of slides and populate them with data from the ' set of records. With ppPres While Not rs.EOF With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle) Let .Shapes(1).TextFrame.TextRange.Text = "A&A - In Any Place" Let .SlideShowTransition.EntryEffect = ppEffectFade With .Shapes(2).TextFrame.TextRange Let .Text = CStr(rs.Fields("Names").Value) Let .Characters.Font.Color.RGB = RGB(255, 0, 255) Let .Characters.Font.Shadow = True End With With .Shapes(3).TextFrame.TextRange Let .Text = CStr(rs.Fields("Mails").Value) Let .Characters.Font.Color.RGB = RGB(255, 0, 255) Let .Characters.Font.Shadow = True End With .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 50 End With rs.MoveNext Wend End With ' Run the show. ppPres.SlideShowSettings.Run Exit Sub err_cmdOLEPowerPoint: MsgBox Err.Number & " " & Err.Description End Sub
André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com

VBA Access: Exportando registros para PARADOX

Exportando registros a partir de uma query do MS Office Access para o banco de dados Paradox. Como posso fazê-lo? Utilizo query com dados a partir do MS Office Excel (*.xls), mas hoje quero enviar dados de planilhas que conectei ao MS Access para uso com MS Excel
Let ReportName = "qrySample" Let ReportFilter = "RecordID = 1" Let ExcelPath = "/Bernardes/" & Session.SessionID & ".xls" Set MSAccess = Server.CreateObject("Access.Application") MSAccess.OpenCurrentDatabase Application("DB") MSAccess.DoCmd.SetWarnings False MSAccess.DoCmd.OpenReport ReportName, 2, , ReportFilter MSAccess.DoCmd.OutputTo 3, ReportName, "MicrosoftExcel(*.xls)", Server.MapPath(ExcelPath), False MSAccess.DoCmd.Close 3, ReportName, 2 MSAccess.DoCmd.SetWarnings True MSAccess.CloseCurrentDatabase MSAccess.Quit 2 Set MSAccess = Nothing
André Luiz Bernardes

VBA Access - Exportando imagens diretamente para os Slides do Powerpoint

Inline image 1

Digamos que temos uma ou mais tabelas cujo o conteúdo seja o caminho (path) de várias de nossas imagens, fotos ou algum conteúdo gráfico. A partir de uma interface simples com botões na nossa aplicação MS Access, podemos criar slides automaticamente enviado nossas fotos, ilustrações e artes para uma apresentação PPT.

Diversos Dashboards contidos em Planilhas do MS Excel, que podem ser abertas, copiadas como imagem dentro do MS Access e automaticamente exportados para o Powerpoint...Usem a imaginação e divirtam-se!

Option Compare Database
Option Explicit

Sub ExToPpt()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape  
Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Open("C:\bernardes\ShowA&APresentation.ppt")
cn.Open CurrentProject.Connection
rs.Open Forms!MyTable.RecordSource, cn 
Do Until rs.EOF
Set pptShape = pptSlide.Shapes.AddPicture(rs.Fields("Picturepath").Value)
rs.Move
Next Loop  
rs.close
cn.close 
Set pptSlide = pptPres.Slides.Add 
End Sub

Reference:

Inspiration:

TagsVBA, Access, Powerpoint, export, image, slide, table, send, PPT, foto, fotos, ilustrações, imagens, photo, exportar

VBA Powerpoint: Populando objetos a partir do MS Office Access.

Muitos utilizam Dashboards & Scorecards, BSC - Balanced Scorecard, KPI - Key Performance Indicator, MIS - Management Information System e Relatórios diretamente nas suas apresentações MS Office Powerpoint, mas como fazê-lo? Como posso atualizar um listbox diretamente no meu Slide? Pois bem, abaixo segue código: Function ListadoAccess(taskPriority as Integer) as String Dim db As DAO.Database Dim rs As DAO.Recordset Dim listOfTasks as String Set db = DBEngine.OpenDatabase("C:\Bernardes.mdb") Set rs = db.OpenRecordset("SELECT * FROM ColorsTable WHERE ColorPriority=" & taskPriority, dbOpenSnapshot) If not rs is nothing then If rs.RecordCount > 0 then With rs While Not .EOF if listOfTask = "" then Let listOfTasks = !ColorName Else Let listOfTasks = listOfColors & vbCrLf & !ColorName End If .MoveNext Loop .Close End With End If Set rs = nothing End If Set db = nothing Let ListadoAccess = listOfColors End Function André Luiz Bernardes

VBA Excel: Identificando o número da semana no Ano.




O código baixo será útil para retornar o número da semana dentro de um ano vigente. Função simples, mas útil... Go ahead! Public Function ISOWeekNum(AnyDate As Date, Optional WhichFormat As Variant) As Integer ' WhichFormat: missing or <> 2 then returns week number, ' = 2 then YYWW Dim ThisYear As Integer Dim PreviousYearStart As Date Dim ThisYearStart As Date Dim NextYearStart As Date Dim YearNum As Integer Let ThisYear = Year(AnyDate) Let ThisYearStart = YearStart(ThisYear) Let PreviousYearStart = YearStart(ThisYear - 1) Let NextYearStart = YearStart(ThisYear + 1) Select Case AnyDate Case Is >= NextYearStart Let ISOWeekNum = (AnyDate - NextYearStart) \ 7 + 1 Let YearNum = Year(AnyDate) + 1 Case Is < ThisYearStart Let ISOWeekNum = (AnyDate - PreviousYearStart) \ 7 + 1 Let YearNum = Year(AnyDate) - 1 Case Else Let ISOWeekNum = (AnyDate - ThisYearStart) \ 7 + 1 Let YearNum = Year(AnyDate) End Select If IsMissing(WhichFormat) Then Exit Function If WhichFormat = 2 Then Let ISOWeekNum = CInt(Format(Right(YearNum, 2), "00") & Format(ISOWeekNum, "00")) End If End Function André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com

VBA: Imprimindo em Matricial.

Eventualmente precisaremos imprimir dados em impressoras matriciais. E isso será possível por condicionarmos a saída dos dados pela porta LPT1. Function PressMatricialReport() Dim nPort as String Dim nLogo as String Let nPort = "LPT1" Let nLogo= "Logo.bmp" Open nPort For Output As #1 Open nLogo For Binary As #2 Let img = Space(LOF(2)) Get #2, 1, img Close #2 Print #1, CHR (2) + "Nome" Print #1, img Print #1, CHR (2) + "..." Print #1, CHR (2) + ":.:.:" + Chr(1) Print #1, CHR (2) + "..:..:..:.." Print #1, CHR (2) + "." Print #1, CHR (2) + "." Print #1, ";;;;;;;" Print #1, "Bernardes" + "NomeImg" Print #1, "Luiz" & texto Print #1, "Andre" & barra Print #1, "007" Print #1, "Out" Print #1, CHR (2) + "" Close #1 End Function André Luiz Bernardes

VBA: Uso do comando SHELL com as aplicações VBA

VBA: Uso do comando SHELL com as aplicações VBA


Veja também:


Talvez a utilização deste comando SHELL seja rara, mas como desejo ser abrangente deixarei um registro sobre o assunto.

Tanto no MS Excel, quanto no MS Access e nas demais aplicações MS Office que utilizam o VBA, sempre recebemos uma mensagem de erro "chamada de procedimento inválida" quando tentamos utilizar quaisquer comandos principais do MS-DOS com a função SHELL. Por quê?

Isso ocorre porque a função SHELL no VBA não inicia uma instância específica do interpretador de comando do MS-DOS (Command.com ou CMD). Ou seja, os principais comandos do MS-DOS não estão presentes.

Somente arquivos que têm as extensões .exe.com ou .bat podem ser executados através da função de SHELL sem maiores transtornos. Os comandos que retornam a mensagem de erro "chamada de procedimento inválida", são: DIRCLSDELETECDMDRDMKDIRRMDIRCOPIAR.


Solucione esse problema executando comandos VBA equivalentes:

Execute a maioria das funções fornecidas pelo Command.com através de comandos similares incluídos no VBA:


MS-DOS                              VBA

DEL [drive][path]filename               Kill "[drive][path]filename"

CD [drive][path]                              ChDir "[drive][path]"

MD [drive][path]directory name     MkDir "[drive][path]directory name"

RD [drive][path]directory name      RmDir "[drive][path]directory name"

COPY [source] [destination]           FileCopy "[source]","[destination]"

DIR [path]                                        Dir("[path]",[attributes])


IMPORTANTE: O VBA para os comandos de diretórios de aplicativos não funcionam do mesmo modo como os seus equivalentes no MS-DOS, o qual em muitos casos requer código extra para recuperar um diretório inteiro, por exemplo. Nos casos em que forem absolutamente essenciais o uso dos principais comandos do MS-DOS, sempre será possível chamarmos uma instância do interpretador de comandos manualmente e passar para o comando desejado.



Experimente a seguinte sintaxe:
Let a = Shell("command.com /c [command]", [WindowStyle])

IMPORTANTE: Deve-se incluir /c para que o comando a ser executado ocorra corretamente.

Por exemplo, para executar um comando de diretório em todos os arquivos ocultos no diretório raiz, use a seguinte sintaxe:

Shell("command.com /c dir c:\ /ah", 1)

Em uma sessão do MS-DOS normal quando estiver usando o Windows, o interpretador de comando MS-DOSCommand.com (ou CMD), estará presente para lidar com os comandos de núcleo.

Para mostrar que o interpretador de comando MS-DOS (Command.com ou CMD), não está na memória, use o código VBA a seguir para o comando de aplicativos: a = Shell("MEM /C /P", 1)

Compare isso com a saída do comando MEM quando for executado numa sessão do MS-DOS no Windows. A única diferença é que o Command.com (ou CMD) não esteja na memória dentro do ambiente criado pelo VBA através da função shell de aplicativos.


Hurry Up!




Envie seus comentários e sugestões e compartilhe este artigo!
brazilsalesforceeffectiveness@gmail.com
✔ Brazil SFE®✔ Brazil SFE®´s Facebook´s Profile  Google+   Author´s Professional Profile  ✔ Brazil SFE®´s Pinterest       ✔ Brazil SFE®´s Tweets

VBA Excel - Criando gráficos com VBA


Inline image 1












Veja também:



Talvez deseje aprender a criar gráficos automaticamente através de codificação VBA Considere o seguinte RANGE abaixo:
A B C D
1 Tools Sold Oct Nov Dec
2 South 7.000 6.610 4.827
3 North 1.155 2.914 3.790
4 East 757 659 7.072
5 West 5.012 3.880 4.752


Range("A1:D7").Select Charts.Add
ActiveChart.ChartType = xlColumnClustered ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A3:D7"), PlotBy:= xlRows ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Tools Sold"
With ActiveChart .HasTitle = True .ChartTitle.Characters.Text = "Tools Sales for Qtr 1" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Month" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Sales" End With

Pronto, nem doeu. Espero que através deste amplie a sua experiência.


Tags: VBA, Ecel, gráfico, chart, Tips, 







Direto do MSDN: Different Ways to Take Advantage of the E-mail Features of Excel

Envie pastas do Excel por e-mail e muito mais! http://msdn.microsoft.com/en-us/library/aa203718(office.11).aspx André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com

VBA: Descompacte para uma pasta específica com o WinZip (VBA)

Senhoras e senhores, segue uma funcionalidade muito útil para aqueles
que lidam com grandes volumes de dados e querem acrescentar certa
  sofisticação às suas aplicações.

Que tal compactar e descompactar os dados

Tanto o nome como a pasta destino estão no código do exemplo.
Sub DEScompacte_Zip()
    Dim PathWinZip As String
    Dim FileNameZip As String
      Dim ShellStr As String
    Dim FolderName As String
 
    Let PathWinZip = "C:\A&A\winzip\"

   ' Aqui checaremos o local onde o WinZip está instalado.
   If Dir(PathWinZip & "winzip32.exe") = "" Then
          MsgBox "Por favor, identifique onde a sua cópia do winzip32.exe está instalada e tente novamente"

       Exit Sub
   End If
 
    Let FileNameZip = "C:\Dados\Test.zip"
   Let FolderName = "C:\Dados\"
 
    ' Descompacta o arquivo Zip na pasta FolderName.
   Let ShellStr = PathWinZip & "Winzip32 -min -e" & " " & Chr(34) & FileNameZip & Chr(34) & " " & Chr(34) & FolderName & Chr(34)
 
   ShellAndWait ShellStr, vbHide

    MsgBox "Observe a pasta " & FolderName & " onde os arquivos foram descompactados"
End Sub
André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com

VBA Word: Checando o número de revisões logo ao abrir o documento.

Vida de escritor não é fácil, precisa-se de 'n' revisões até se chegar ao resultado final, seja ele um texto simples ou mesmo um livro (na verdade nada muito diferente do que fazemos em progração, 'n' revisões). Bem, com respeito ao MS Office Word poderá acompanhar as 'n' versões logo que abrir o seu documento, por utilizar o código abaixo. Divirta-se... Dim rev As Revision Debug.Print ActiveDocument.Revisions.Count For Each rev In ActiveDocument.Revisions Debug.Print rev.Index Debug.Print rev.Type Debug.Print rev.Author Debug.Print rev.Date Debug.Print rev.Range.Text Next André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com

VBA Excel: Retornando o período em ANOS, MESES e SEMANAS.

Olá caros senhores e algumas senhoras (digo senhoritas), A questão da idade é mesmo muito sensível a muitos, por isso é sempre prudente tomar cuidado com ela. Com isto em mente disponibilizo uma função básica, mas super útil para a utilização de alguns. A partir de 2 datas retornará o período ocorrido entre elas. Function Era(Date1 As Date, Date2 As Date) As String Dim Y As Integer Dim M As Integer Dim D As Integer Dim Temp1 As Date Let Temp1 = DateSerial(Year(Date2), Month(Date1), Day(Date1)) Let Y = Year(Date2) - Year(Date1) + (Temp1 > Date2) Let M = Month(Date2) - Month(Date1) - (12 * (Temp1 > Date2)) Let D = Day(Date2) - Day(Date1) If D < 0 Then Let M = M - 1 Let D = Day(DateSerial(Year(Date2), Month(Date2) + 1, 0)) + D + 1 End If Let Era = Y & " anos " & M & " meses " & D & " dias" End Function André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com

VBA Powerpoint: Veja os dados do MS Access em seus Slides.

Você pode desejar trazer dados da sua aplicação MS Office Access para seus slides, oferecendo-lhes opções
disponíveis em suas tabelas.

Posteriormente, em outro tópico, faremos isso com gráficos. No momento vale o seu estudo e ensaio
com tal funcionalidade tão relevante. Esta certamente acrescentará e tornará certos aspectos mais
apresentáveis e por conseguinte, mais profissionais.

Como sempre...Divirtam-se!


Function GetTaskListFromAccess(taskPriority as Integer) as String
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim listOfTasks as String

  Set db = DBEngine.OpenDatabase("C:\Bernardes.mdb")

  Set rs = db.OpenRecordset("SELECT * FROM BernardesTable WHERE TaskPriority=" & _
                            taskPriority, dbOpenSnapshot)
  If not rs is nothing then
    If rs.RecordCount > 0 then
      With rs
        While Not .EOF
          if listOfTask = "" then
            listOfTasks = !TaskName
           Else
            listOfTasks = listOfTasks & vbCrLf & !TaskName
          End If
          .MoveNext
        Loop
      .Close
      End With
    End If
    Set rs = nothing
  End If
  Set db = nothing

  GetTaskListFromAccess = listOfTasks
End Function

Certifique-se de efetuar a referência ao "Microsoft DAO Object Library" no seu VBA project.

Para popular o seu "textbox" na sua apresentação PowerPoint, poderá chamar algo como o demonstrado na função a seguir, que retornará uma lista de conteúdo.


André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com

VBA Powerpoint: Misturando os slides durante a apresentação.

Que tal ter uma apresentação que nunca será mostrada do mesmo jeito!

Informe o primeiro e o último slide disponível e em seguida a aplicação será mostrada aleatoriamente.


Dentro de um range, determinado por você, a sequência seguida será determinada aleatoriamente pelo código abaixo.

Sub Misturando()
Dim Iupper As Integer
Dim Ilower As Integer
Dim Ifrom As Integer
Dim Ito As Integer
Dim i As Integer

Let Iupper = InputBox("Qual o nº do 1º Slide que gostaria de considerar:")
Let Ilower = InputBox("Qual o nº do último Slide que deseja misturar na apresentação:")

If Iupper > ActivePresentation.Slides.Count Or Ilower < 1 Then GoTo err

For i = 1 To 2*Iupper
Randomize

Let Ifrom = Int((Iupper - Ilower + 1) * Rnd + Ilower)
Let Ito = Int((Iupper - Ilower + 1) * Rnd + Ilower)

ActivePresentation.Slides(Ifrom).MoveTo (Ito)
Next i

Exit Sub

err:
MsgBox "Sua escolha está fora de uma faixa real!", vbCritical
End Sub


André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com

VBA Powerpoint: Torne homogêneas todas as fontes e cores da sua apresentação.

Sabe aquelas situações onde você recebe uma apresentação do MS Office Powerpoint e precisa deixar todos os Slides com a mesma cor e as mesmas fontes:

Geralmente isso leva um tempo enorme, além de ser muito chato.

Pois bem, seus problemas acabaram com o código abaixo as mudanças em todos os Slides serão efetuadas automaticamente de uma só vez e de modo automatizado.

Excelente não é mesmo...Divirta-se!


Sub allchange()
Dim osld As Slide, oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
'Title text change values as required
If oshp.PlaceholderFormat.Type = 1 or oshp.PlaceholderFormat.Type = 3 Then
With oshp.TextFrame.TextRange.Font
.Name = "Arial"
.Size = 36
.Color.RGB = RGB(0, 0, 255)
.Bold = msoFalse
.Italic = msoFalse
.Shadow=false
End With
End If
If oshp.PlaceholderFormat.Type = 2 or oshp.PlaceholderFormat.Type = 7 Then
'Body text change values as required
With oshp.TextFrame.TextRange.Font
.Name = "Arial"
.Size = 24
.Color.RGB = RGB(255, 0, 0)
.Bold = msoFalse
.Italic = msoFalse
.Shadow=false
End With
End If
End If
Next oshp
Next osld
End Sub



André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com

VBA Excel: Inserindo novas pastas na planilha.

Planos de Contas, Agrupamentos, lista de diferentes locais, etc...

Por 'n' motivos precisamos criar pastas no MS Office Excel. Como fazê-lo aparentemente de forma
automática?

Abaixo está o modo, simples e funcional.

Boa diversão!


Dim ws As Worksheet                    ' Cria um objeto "worksheet".

Set ws = Sheets.Add                    ' Adiciona uma nova pasta na planilha.

ws.Name = "NewName"                    ' Atribui um nome a pasta.

André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com

VBA Outlook: Reencaminhar mensagens enviadas como ocultas.

Controle o fluxo de informações ocultas da sua máquina, rede, departamento, etc... Esta pequena funcionalidade permite que acompanhe o que vem trafegando na sua rede.

A funcionalidade abaixo é apenas um exercício de como manipular as mensagens dentro do MS Office Outlook.



Private Sub Application_ISend(ByVal Item As Object, Cancel As Boolean)
    ' Author:                     Date:               Contact:
    ' André Bernardes             02/05/2009 09:15    bernardess@gmail.com
    ' Reencaminhar mensagens enviadas para outro destinatário através do campo Bcc
   
    Dim objMe As Recipient

    Set objMe = Item.Recipients.Add("bernardess@gmail.com")

    objMe.Type = olBCC
    objMe.Resolve

    Set objMe = Nothing
End Sub


André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com

VBA Excel: Envie um email com sua planilha a partir do Excel

Já imaginou enviar sua mensagem diretamente para as pessoas que deseja apenas pelo pressionamento de teclas de combinação ou um pequeno botão na planilha?

Pois isso será possível através do código abaixo:

Não se esqueça de efetuar as referências ao MS Outlook. Este código deve ser colocado num módulo dentro do MS Excel.


Sub MailPlan()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
  .To = "bernardess@gmail.com"
  .Subject = "A&A: Teste de envio a partir do Excel " & Format$(DateAdd("m", -1, Date), "mmmm")
  .Body = "A assiduidade do mês de " & Format$(DateAdd("m", -1, Date), "mmmm")

  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs ("c:\teste.xls")
  Application.DisplayAlerts = True

  .Attachments.Add ActiveWorkbook.FullName
  'No Excel 97 use ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
  .Display 'ou para enviar direto sem interface use .Send

End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub



André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com

VBA Outlook: Inserindo Assinatura programaticamente.

Sua assinatura no MS Outlook pode ser personlaizada via vba. Desse modo, caso trabalhe em diversos cliente, poderá inserir o código abaixo em cada máquina onde utilizar o MS Outlook. Para esta aplicação faz-se necessário as refências mostradas Sub InMySig() ' Author: Date: Contact: ' André Bernardes 02/05/2009 09:15 bernardess@gmail.com ' Insere assinatura. Call InSignature("Bernardes") End Sub Sub InSignature(strSigName As String) ' Author: Date: Contact: ' André Bernardes 02/05/2009 09:15 bernardess@gmail.com ' Atenção ao "Nome da assinatura", este precisa ser igual ao que aparece ' nos menus e caixas de diálogo. Dim objItem As Object Dim objInsp As Outlook.Inspector ' Precisa que a referência ao Microsoft Office Word esteja pronta. Dim objDoc As Word.Document Dim objSel As Word.Selection ' Precisa que a referência ao Microsoft Office esteja pronta. Dim objCB As Office.CommandBar Dim objCBP As Office.CommandBarPopup Dim objCBB As Office.CommandBarButton Dim colCBControls As Office.CommandBarControls On Error Resume Next Set objInsp = Application.ActiveInspector If Not objInsp Is Nothing Then Set objItem = objInsp.CurrentItem If objItem.Class = olMail Then ' Caso o editor seja WordMail. If objInsp.EditorType = olEditorWord Then ' Nesta opção ativa a caixa de diálogo de segurança do Outlook. Set objDoc = objInsp.WordEditor Set objSel = objDoc.Application.Selection If objDoc.Bookmarks("_MailAutoSig") Is Nothing Then objDoc.Bookmarks.Add Range:=objSel.Range, Name:="_MailAutoSig" End If objSel.GoTo What:=wdGoToBookmark, Name:="_MailAutoSig" Set objCB = objDoc.CommandBars("AutoSignature Popup") If Not objCB Is Nothing Then Set colCBControls = objCB.Controls End If Else ' Caso o editor não seja o WordMail. ' Acessa o menu 'Insert | Signature'. Set objCBP = Application.ActiveInspector.CommandBars.FindControl(, 31145) If Not objCBP Is Nothing Then Set colCBControls = objCBP.Controls End If End If End If If Not colCBControls Is Nothing Then For Each objCBB In colCBControls If objCBB.Caption = strSigName Then objCBB.Execute Exit For End If Next End If End If Set objInsp = Nothing Set objItem = Nothing Set objDoc = Nothing Set objSel = Nothing Set objCB = Nothing Set objCBB = Nothing End Sub André Luiz Bernardes A&A - WORK, DON´T PLAY! http://al-bernardes.sites.uol.com.br/ bernardess@gmail.com

Conheçam o futuro da Web 2.0 e além!

Conheçam o futuro da Web 2.0 e além!
 
Clique aqui

 socialmedia-090328174027-phpapp02-thumbnail?1238281714http://www.slideshare.net/bernardes/social-media-1215419

Enviem a outros..
Esta mensagem pode conter informação confidencial e/ou privilegiada. Se você não for o destinatário ou a pessoa autorizada a receber esta mensagem, não pode usar, copiar ou divulgar as informações nela contidas ou tomar qualquer ação baseada nessas informações. Se você recebeu esta mensagem por engano, por favor avise imediatamente o remetente, respondendo o e-mail e em seguida apague-o. Agradecemos sua cooperação.



André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com

+55 (13) 9152-2565

Esta mensagem pode conter informação confidencial e/ou privilegiada. Se você não for o destinatário ou a pessoa autorizada a receber esta mensagem, não pode usar, copiar ou divulgar as informações nela contidas ou tomar qualquer ação baseada nessas informações. Se você recebeu esta mensagem por engano, por favor avise imediatamente o remetente, respondendo o e-mail e em seguida apague-o. Agradecemos sua cooperação.

VBA Excel: Identificando verdadeiramente a última célula de uma planilha.

Entre todas as técnicas de VBA, esta é uma das melhores. já tive a oportunidade de disponibilizar aqui outros modos de como identificar qual é a última linha (ou o último registro) numa planilha de dados.

Para ser breve e suscinto, as outras técnicas volta e meia eram falhas devido a "dirty area".

Depois de algum tempo alguns programadores acharam a melhor técnica para identificarmos a última ocorrência sem falhas. O exemplo abaixo é uma variante da técnica ensinada por Bob Umlas. Testem naquelas bases de dados mais "parrudas", com grandes quantidades de dados, acima de 30.000 linhas e vejam o excelente resultado.


Function LCell(ws As Worksheet) As Range
  Dim LRow&, LCol%

  On Error Resume Next

  With ws
    Let LRow& = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    Let LCol%   = .Cells.Find(What:="*", SearchDirection:=xlPrevious,  SearchOrder:=xlByColumns).Column
  End With

  Set LCell = ws.Cells(LRow&, LCol%)
End Function
Usando esta função:
A função LCell demonstrada aqui não poderá ser utilizada diretamente em uma planilha, mas poderá ser evocada a partir de outro procedimento VBA. Implemente o código como abaixo:

Sub Identifica()
   MsgBox LCell(Sheet1).Row
End Sub


André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com
diHITT - Notícias