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
VBA Access: Exportando dados da query para Slides PPT
Exporte o conteúdo de suas queries diretamente para o MS Office Powerpoint.
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
VBA Access - Exportando imagens diretamente para os Slides do Powerpoint
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)Next Loop
rs.Move
rs.close
cn.close
Set pptSlide = pptPres.Slides.AddEnd Sub
Reference:
Inspiration:
Tags: VBA, 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: DIR, CLS, DELETE, CD, MD, RD, MKDIR, RMDIR, COPIAR.
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 VBADEL [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-DOS, Command.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!
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
VBA Excel - Criando gráficos com VBA
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
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
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.
André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com
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 SubAndré 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!
André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com
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!
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!
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.
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com
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 BernardesA&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.
André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com
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 SubAndré 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
![]()
http://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.
Clique aqui
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.
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:
André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com
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
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:
André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com
Assinar:
Postagens (Atom)