VBA Excel - Fechando planilha sem Salvar

VBA Excel - Fechando planilha sem Salvar Como fechamos uma planilha sem que ela pergunte se desejo salvar?

Suponhamos que a versão que está disponibilizando não possa ser alterada ou que você tenha um bom motivo para não permitir que seus usuários gravem alguma coisa nela...Segue modelo:

' Essa simples rotina, pode fazer um estrago...
' 1 - Fecha a pasta de trabalho ativa, SEM SALVAR, ou
' 2 - Fecha TODAS as pastas de trabalho abertas

             
Sub CloseNotSave()                

  ' Informa ao Excel que a pasta já está salva
  ThisWorkbook.Saved = True
                  
  ' Fecha a pasta de trabalho. O Excel fica aberto.
  ' Se houver outras pastas abertas, ficarão abertas
  ThisWorkbook.Close

  ' Para sair do Excel (encerrar o aplicativo) sem
  ' salvar TODAS as pastas abertas:                 
    ' Aqui ele procura (loop) pastas abertas
    ' For i = 1 To Application.Workbooks.Count
      ' Diz ao Excel que a pasta já está salva
      ' Application.Workbooks(i).Saved = True
                      
      ' Procura outras pastas abertas, até a última
    ' Next
                  
  ' Diz ao Excel que está tudo bem, que é para fechar o
  ' "estabelecimento", e ir descansar
  ' Application.Quit                
End Sub


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 novas Planilhas a partir das pastas existentes em uma planilha.

Como criar várias planilhas diferentes a partir das pastas dentro da minha planilha?

Sub SavePlansAtWorkBook()
    Dim
nPath As String
    Dim nExt as String
    Dim nWS As Worksheet

    Let nPath = "P:\A&A\"
    Let nExt = ".xls"

    For Each nWS In ThisWorkbook.Worksheets
   
    nWS.Copy

   
    ActiveWorkbook.SaveAs _
        Filename:=nPath & nWS.Name & nExt

   
    ActiveWindow.Close
    Next nWS
End Sub

André Luiz Bernardes

Excel Basic - Número é PAR ou ÍMPAR


header_home01.jpg

Blog Office VBA | Blog Excel | Blog Access | 

Como podemos descobrir se o conteúdo de certas células é par ou ímpar?

Podemos utilizar a combinação das seguintes funções:


                =SE(MOD(A2;2)=0;VERDADEIRO;FALSO)



Reference:
Tags: VBA, Excel, par, ímpar, function, Office


VBA Access - Convertendo o conteúdo de um TextBox em Data (Convert TextBox values to Dates)



Conversões são tão comuns que chegam a ser monótonas. Mas entendo que são fundamentais para quem está começando...Freqüentemente utilizo textboxes como campo para o dataentry de Datas (Date). O problemas é que apesar de formatá-los para se parecerem com uma data, continuam contendo um valor text. A função CDate() é uma boa solução para este trabalho. Escrevo uma function e mando todo o trabalho para essa função interna. Minha function captura o tipo texto (Text) e o converte para data (Date).







Function Vert2Dt(dtStr As String) As Date
      ' Converte o conteúdo do textbox formatado como data em uma data "real".
 
      Let Vert2Dt = CDate(Left$(dateString, 2) & "/" & Mid$(dateString, 3, 2) & "/" & Right$(dateString, 4))
End Function



References
:

Tags: VBA, Access, convertions, conversões, Date, Text, 





VBA Access - Verificando sua Listbox (Check your listbox)

Quando utilizamos uma Listbox...

... Por exemplo, talvez queiramos habilitar um botão na nossa interface quando um determinado item da lista for selecionado, ou talvez queiramos executar uma rotina para retirar a seleção, mas somente se alguns dos itens já estiverem selecionados (caso contrário poderemos estipular outras ações).

A função abaixo tem como alvo um objeto ListBox e retornará True caso qualquer valor estiver selecionado.













Function HaALgoSelecionado (nLista As Access.ListBox) As Boolean
               ' Retorna true se algum item estiver selecionado no listbox.

  Dim nOccur As Long
 
  For nOccur = 0 To lst.ListCount - 1
    If nLista.Selected(nOccur) Then
      Let HaALgoSelecionado = True
      Exit For
    End If
  Next i
 
End Function


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

bernardess@gmail.com
inanyplace
bernardess@gmail.com

Excel: Como as planilhas aumentam inexplicavelmente?

Já notou que o tamanho das nossas planilhas ficam maiores com o passar do tempo, sem que necessariamente tenhamos acrescentado algum conteúdo relevante a elas?

É muito comum que somente tenhamos aberto o nosso arquivo e efetuado pequenas alterações em certas células.

Tudo bem, vez ou outra inserirmos algumas linhas em branco, apenas para posicionar algumas informações. Mas com o passar do tempo, percebemos que:

   As linhas em branco não sumiram, eliminando o conteúdo anteriormente existente, antes muitas
   delas são salvas como se o conteúdo permanecesse.

   As exclusões de várias células, colunas e fórmulas findam por não diminuir em nada o tamanho
   total do nosso arquivo.

Lógico, isso é muito comum devido a grande manipulação de dados que efetuamos dentro das mesmas planilhas, muitas delas cheias de links com outras planilhas, sites e bancos de dados.

O MS Excel não consegue distinguir as linhas que estão realmente em branco ou vazias e acaba por gravar todas as ocorrências em branco como se contivessem conteúdo.

O tamanho das planilhas é uma preocupação constante nas nossas aplicações. A não ser que realmente precisemos ter ocorrências extensas, deveríamos automatizar a deleção das linhas excedentes sempre que nossas planilhas fossem fechadas.

Mas como eliminaremos linhas em branco e salvaremos a planilhas antes da mesma ser fechada de modo automatizado?


Vejam aqui várias sugestões...
Blog Excel
Blog Access
Blog Office



VBA Excel - Eficiência para deletar milhares de linhas (Delete thousand lines).

Talvez precise deletar planilhas com milhares de linhas em branco, poderá usar
a funcionalidade abaixo.

Function DelThousandBlnkRows(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




Vejam outras várias sugestões...
Blog Excel
Blog Access
Blog Office




VBA Excel - Excluindo linhas em branco (Delete Blank Cells)


Continuando com as opções quanto customizar as planilhas, retirando delas todos os espaços não usados temos a função abaixo que deletará todas as células em branco que estiverem na coluna D.

Sub DelBlankRows()
        Range("D1:D" & Cells _
        (Rows.Count,2).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub



TagsExcel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines



André Luiz Bernardes
A&A® - In Any Place.

VBA Excel - Excluindo linhas duplicadas em coluna ordenada.

São inesgotáveis as perguntas sobre como excluir linhas duplicadas. Ao executar o código abaixo é necessário que a coluna considerada esteja ordenada.


Sub DelDoubleLine()
        Dim nLine As Long
        Dim nString, nRow As String
        Dim nAdress as String

        Let nLine = 1
        Let nAdress = "B10"

        Range(nAdress).Select

        Let str = Range(nAdress).Value

        Do While Not ActiveCell.Offset(nLine).Value = ""
                If ActiveCell.Offset(nLine).Value = nString Then
                        GoSub DeleteRow
                Else
                        Let nString = ActiveCell.Offset(nLine).Value
                        Let nLine = nLine + 1
                End If
        Loop

        Exit Sub

DeleteRow:
        Let nRow = nLine + 1 & ":" & nLine + 1

        Rows(nRow).Select

        Selection.Delete Shift:=xlUp

        Range(nAdress).Select

        Return
End Sub


Vejam outras várias sugestões...
Blog Excel
Blog Access
Blog Office



VBA - Samples, Examples, Tips, Tricks, Code, Download, Office, etc...

Usem e divulguem


VBA Office    -  VBA para MS Office - Todos os aplicativos da Suíte Office.


VBA Access -  VBA para MS Access - Códigos, exemplos, Definições.


VBA Excel     -  VBA para MS Excel - Códigos, exemplos, Definições.


E aguardem, outros virão...


VBA Excel - Desabilitando os Menus - 2003/2007

Hello Folks!

Para tornar as nossas aplicações mais profissionais e até mesmo impedir que os nossos "queridos usuários" utilizem alguma funcionalidade que não desejamos, costumamos tornar os menus principais indisponíveis.

Fazendo isso podemos "protegê-los" (e a nós mesmos) de alguns erros inoportunos.

Dica compartilhada pelo amigo Denis Ostorero

VERSÃO 2003
For Each Barras In Application.CommandBars
    Let Barras.Visible = True ' Desabilita todas as barras do MS Excel.
Next

Restaurando...
For Each Barras In Application.CommandBars
    Let Barras.Visible = True ' Re-habilita todos os Menus do MS Excel.Next
Next

VERSÃO 2007
With Application
    Let .DisplayFormulaBar = False ' Desabilita o Menu de fórmula.
    Let .DisplayStatusBar = False   ' Desabilita o Menu de Status.
    Let .DisplayFullScreen = True
    Let .CommandBars("Full Screen").Visible = False
    Let .CommandBars("Worksheet Menu Bar").Enabled = False
End With

Restaurando...
With Application
    Let .DisplayFormulaBar = True ' Re-habilita o Menu de fórmulas.
    Let .DisplayStatusBar = True   ' Re-habilita o Menu de Status.
    Let .DisplayFullScreen = False
    Let .CommandBars("Worksheet Menu Bar").Enabled = True
End With

Google Talk: bernardess@gmail.com
Skype: inanyplace
MSN: bernardess@gmail.com

VBA Access - Saiba qual é a sua versão de Access

Certifique-se de qual versão do MS Access está sendo utilizada

É simples, mas pode salvá-lo quando estiver rodando sua aplicação num
ambiente com várias versões do MS Access...
  • Você poderá restrigir o accesso a sua base de dados caso o usuário final tenha uma versão incompatível do Access.
  • Poderá adicionar ou excluir certas funcionalidades da sua aplicação de acordo com a versão do MS Access presente.
1
2
3
4
5
6
Function GetAccessVersion() As Long
' returns application version

  Let GetVersion = Application.SysCmd(acSysCmdAccessVer)

End Function

Para que retorne a versão do Access na sua aplicação, apenas evoque GetAccessVersion(). abaixo estão os números correspondentes às versões mais recentes:

  • MS Access 97 — Versão 8
  • MS Access 2000 — Versão 9
  • MS Access 2002 — Versão 10
  • MS Access 2003 — Versão 11
  • MS Access 2007 — Versão 12


André Luiz Bernardes

VBA Access - Onde este CAMPO é usado?

Esta é uma funcionalidade que lhe quebrará um "galhão". Sua utilidade? Vascular todas as suas tabelas, formulários, relatórios e identificar onde o seu campo é particularmente usado. São não faz as buscas no código VBA (o que o Access lhe propicia facilmente).

Poderá utilizar essa funcionalidade sob os seguintes cenários:

  • Um relatório requer um parâmetro, mas você não consegue ver onde o nome do campo foi usado.
  • Antes que renomeie um campo, você quer saber quais objetos na sua aplicação dependem deste campo.

Para adicionar esta funcionalidade à sua aplicação, basta que:

  1. Crie um novo módulo
  2. Copie o código abaixo, e cole-o dentro do seu novo módulo.
  3. Certifique-se de que o MS Access entende o código colado: Compile o código.
  4. Salve o código com o nome que achar melhor, algo como basSearchField.

Para usá-lot, basta que abra a janela "Immediate Windo" (Ctrl+G) e digite:
    ? FindField()

The utility does more than just search for the field's Name:

  • In tables and queries, it searches searches the Caption. The user knows the field by this name, and sometimes Access misidentifies a field based on its caption (if Name AutoCorrect is turned on.)
  • In queries, it checks the SourceName (i.e. the original name of the field in a table) since the field may be aliased.
  • In forms and reports, it searches the Name, ControlSource, and Caption of controls.
  • For reports, it searches the GroupLevels (the Sorting and Grouping pane.)
  • For subforms and subreports, it checks the LinkMasterFields and LinkChildFields.
  • For all object types, it searches the Filter and OrderBy properties, as these cause Access to ask for a parameter.

If you want something more, there are commercial utilities such as Find And Replace (Ricks World), Speed Ferret (Black Moshannon), or Total Access Analyzer (FMS Inc.)



Option Compare Database
Option Explicit

'Purpose: Search your database (tables, queries, forms, reports)
' to find where a particular field name is used.
'Release: April 2007 (a work in progress.)
'Documentation: http://allenbrowne.com/ser-73.html
'Author: Allen Browne (allen@allenbrowne.com)
'Versions: Requires Access 2000 and later.
' For Access 2000, you will need to remove this from the end of several lines:
' , WindowMode:=acHidden

'Usage examples
'==============
' To find where InvoiceID is used in Report1:
' ? FindField("InvoiceID", "Report1")
' To find where ClientID is used in all forms and reports:
' ? FindField("ClientID",,ffoForm + ffoReport)
' To find anywhere EventDate is used:
' ? FindField("EntryDate")

'Summary
'=======
' Tables Searches the Name and Caption of the fields, and the Filter and OrderBy of the table.
' Queries: Searches the Name, SourceName, and Caption of fields; Filter and OrderBy of query.
' Forms: Searches Name, ControlSource, Caption of controls,
' and LinkMasterFields/LinkChildFields of subform controls
' Reports: Searches Name, ControlSoruce, Caption of controls, Control Source of Group Levels,
' and LinkMasterFields/LinkChildFields of subreport controls

'Notes
'=====
' When you type a SQL statement into the RecordSource of a form/report, or the RowSource
' of a combo/listbox, Access creates a saved query with a name prefixed with ~sq_.
' With reports, click Ok if notified the report was set up for another printer.
'Does not search RecordSource of form/report, nor RowSource of combo/list box.
'Does not handle renamed fields that might be under the control of Name AutoCorrect.
'Does not handle query parameters (which are not fields.)

'Bitfield constants: their sum indicates which types of object to search.
Public Enum FindFieldObject
ffoTable = 1 'Search table fields.
ffoQuery = 2 'Search query fields.
ffoForm = 4 'Search form controls and properties.
ffoReport = 8 'Search report controls, properties, and group levels.
ffoAll = 15 'Search all (tables, queries, forms, and reports.)
End Enum

Public Function FindField(strFieldName As String, _
Optional strObjectName As String, _
Optional iObjectTypes As FindFieldObject = ffoAll, _
Optional bExactMatchOnly As Boolean) As Long
On Error GoTo Err_Handler
'Purpose: Search the current database for where a field name is used. MAIN FUNCTION.
'Arguments: strFieldName: the field name to find (or part of field name.)
' strObjectName: Leave blank to search all objects. Only named object if entered.
' iObjectTypes: determines what objects to search for. Sum of the types you want.
' bExactMatchOnly: not matched with wildcards if this is True.
'Return: Number of matches found.
' List of items in the Immediate Window (Ctrl+G.)
'Usage: To search tables and queries for a field named Inactive:
' Call FindField("Inactive", ffoTable + ffoQuery)
Dim db As DAO.Database 'This database
Dim tdf As DAO.TableDef 'Each table
Dim qdf As DAO.QueryDef 'Each query
Dim accObj As AccessObject 'Each form/report.
Dim strDoc As String 'Name of form/report.
Dim strText2Match As String 'strFieldName with wildcards.
Dim bLeaveOpen As Boolean 'Flag to leave the form/report open if it was already open.
Dim lngKt As Long 'Count of matches.

'Initialize
Set db = CurrentDb()
If bExactMatchOnly Then
strText2Match = strFieldName
Else
strText2Match = "*" & strFieldName & "*"
End If

'Search Tables
If (iObjectTypes And ffoTable) <> 0 Then
If strObjectName <> vbNullString Then
'Just one table (if it exists)
If ObjectExists(db.TableDefs, strObjectName) Then
Set tdf = db.TableDefs(strObjectName)
lngKt = lngKt + FindInTableQuery(tdf, strText2Match)
End If
Else
'All tables
For Each tdf In db.TableDefs
lngKt = lngKt + FindInTableQuery(tdf, strText2Match)
Next
End If
End If

'Search Queries
If (iObjectTypes And ffoQuery) <> 0 Then
If strObjectName <> vbNullString Then
'Just one query (if it exists)
If ObjectExists(db.QueryDefs, strObjectName) Then
Set qdf = db.QueryDefs(strObjectName)
lngKt = lngKt + FindInTableQuery(qdf, strText2Match)
End If
Else
'All queries
For Each qdf In db.QueryDefs
lngKt = lngKt + FindInTableQuery(qdf, strText2Match)
Next
End If
End If

'Search Forms.
If (iObjectTypes And ffoForm) <> 0 Then
If strObjectName <> vbNullString Then
'Just one form (if it exists)
If ObjectExists(CurrentProject.AllForms, strObjectName) Then
Set accObj = CurrentProject.AllForms(strObjectName)
strDoc = accObj.Name
bLeaveOpen = accObj.IsLoaded
DoCmd.OpenForm strDoc, acDesign, WindowMode:=acHidden
'Search
lngKt = lngKt + FindInFormReport(Forms(strDoc), strText2Match)
'Close unless already open.
If Not bLeaveOpen Then
DoCmd.Close acForm, strDoc, acSaveNo
End If
End If
Else
'All forms
For Each accObj In CurrentProject.AllForms
strDoc = accObj.Name
bLeaveOpen = accObj.IsLoaded
DoCmd.OpenForm strDoc, acDesign, WindowMode:=acHidden
'Search
lngKt = lngKt + FindInFormReport(Forms(strDoc), strText2Match)
'Close unless already open.
If Not bLeaveOpen Then
DoCmd.Close acForm, strDoc, acSaveNo
End If
Next
End If
End If

'Search Reports.
If (iObjectTypes And ffoReport) <> 0 Then
If strObjectName <> vbNullString Then
'Just one report (if it exists)
If ObjectExists(CurrentProject.AllReports, strObjectName) Then
Set accObj = CurrentProject.AllReports(strObjectName)
strDoc = accObj.Name
bLeaveOpen = accObj.IsLoaded
DoCmd.OpenReport strDoc, acDesign, WindowMode:=acHidden
'Search
lngKt = lngKt + FindInFormReport(Reports(strDoc), strText2Match)
'Check the Group Levels as well.
lngKt = lngKt + FindInGroupLevel(Reports(strDoc), strText2Match)
'Close unless already open.
If Not bLeaveOpen Then
DoCmd.Close acReport, strDoc, acSaveNo
End If
End If
Else
'All reports
For Each accObj In CurrentProject.AllReports
strDoc = accObj.Name
bLeaveOpen = accObj.IsLoaded
DoCmd.OpenReport strDoc, acDesign, WindowMode:=acHidden
'Search
lngKt = lngKt + FindInFormReport(Reports(strDoc), strText2Match)
'Check the Group Levels as well.
lngKt = lngKt + FindInGroupLevel(Reports(strDoc), strText2Match)
'Close unless already open.
If Not bLeaveOpen Then
DoCmd.Close acReport, strDoc, acSaveNo
End If
Next
End If
End If

Exit_Handler:
FindField = lngKt
'Clean up
Set accObj = Nothing
Set qdf = Nothing
Set tdf = Nothing
Set db = Nothing
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "FindField"
Resume Exit_Handler
End Function

Private Function FindInTableQuery(obj As Object, strText2Match As String) As Long
On Error GoTo Err_Handler
'Purpose: Find fields where the Name, SourceField, or Caption matches the string.
'Arguments: obj = the TableDef or QueryDef to search.
' strText2Match is the text to search for, including any wildcards.
'Return: Count of matches listed.
Dim fld As DAO.Field
Dim lngKt As Long

For Each fld In obj.Fields
'Search the name
If fld.Name Like strText2Match Then
Debug.Print obj.Name & "." & fld.Name
lngKt = lngKt + 1&
'Search the SourceField (for aliased query fields.)
ElseIf fld.SourceField Like strText2Match Then
Debug.Print obj.Name & "." & fld.Name & ".SourceField: " & fld.SourceField
lngKt = lngKt + 1&
'Search the Caption.
ElseIf HasProperty(fld, "Caption") Then
If fld.Properties("Caption") Like strText2Match Then
Debug.Print obj.Name & "." & fld.Name
lngKt = lngKt + 1&
End If
End If
Next
Set fld = Nothing

'Search the Filter and OrderBy properties too.
lngKt = lngKt + FindInProperty(obj, "Filter", strText2Match)
lngKt = lngKt + FindInProperty(obj, "OrderBy", strText2Match)

Exit_Handler:
FindInTableQuery = lngKt
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "FindInTableQuery"
Resume Exit_Handler
End Function

Private Function FindInFormReport(obj As Object, strText2Match As String) As Long
On Error GoTo Err_Handler
'Purpose: Search for controls where the Name, Control Source, or Caption matches the string.
'Arguments: obj = a reference to the form or report.
' strText2Match is the text to search for, including any wildcards.
'Return: Count of matches listed.
Dim ctl As Control 'Each control on the form/report.
Dim lngKt As Long 'Count of matches.

For Each ctl In obj.Controls
'Search the name
If ctl.Name Like strText2Match Then
Debug.Print obj.Name & "." & ctl.Name & " (" & ControlTypeName(ctl.ControlType) & ")"
lngKt = lngKt + 1&
'LinkMasterFields/LinkChildFields for subform/subreport.
ElseIf ctl.ControlType = acSubform Then
If ctl.LinkMasterFields Like strText2Match Then
Debug.Print obj.Name & "." & ctl.Name & ".LinkMasterFields: " & ctl.LinkMasterFields
lngKt = lngKt + 1&
End If
If ctl.LinkChildFields Like strText2Match Then
Debug.Print obj.Name & "." & ctl.Name & ".LinkChildFields: " & ctl.LinkChildFields
lngKt = lngKt + 1&
End If
'Search the Control Source
ElseIf HasProperty(ctl, "ControlSource") Then
If ctl.ControlSource Like strText2Match Then
Debug.Print obj.Name & "." & ctl.Name & ".ControlSource: " & ctl.ControlSource
lngKt = lngKt + 1&
End If
'Search the caption (less any hotkey.)
ElseIf HasProperty(ctl, "Caption") Then
If ctl.Caption Like Replace(strText2Match, "&", vbNullString) Then
Debug.Print obj.Name & "." & ctl.Name & ".Caption: " & ctl.Caption
lngKt = lngKt + 1&
End If
End If
Next

'Search the Filter and OrderBy properties too.
lngKt = lngKt + FindInProperty(obj, "Filter", strText2Match)
lngKt = lngKt + FindInProperty(obj, "OrderBy", strText2Match)

Exit_Handler:
FindInFormReport = lngKt
Set ctl = Nothing
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "FindInFormReport"
Resume Exit_Handler
End Function

Private Function FindInProperty(obj As Object, strPropName As String, strText2Match As String) As Long
On Error GoTo Err_Handler
'Purpose: Search the Filter an OrderBy properties of the object for the string.
'Arguments: obj = a reference to TableDef, QueryDef, Form, or Report.
' strPropName = name of property to search, e.g. "Filter" or "OrderBy".
' strText2Match = the text to search for, including any wildcards.
'Return: 1 if found; 0 if not.

If obj.Properties(strPropName) Like strText2Match Then
Debug.Print obj.Name & "." & strPropName & ": " & obj.Properties(strPropName)
FindInProperty = 1&
End If

Exit_Handler:
Exit Function

Err_Handler:
Select Case Err.Number
Case 438&, 3270& 'Property doesn't apply; Property not found.
'do nothing
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, ".FindInProperty"
End Select
Resume Exit_Handler
End Function

Private Function FindInGroupLevel(rpt As Report, strText2Match As String) As Long
On Error GoTo Err_Handler
'Purpose: Search the Control Source of each Group Level of a report.
'Arguments: rpt = a reference to the report.
' strText2Match is the text to search for, including any wildcards.
'Return: Count of matches listed.
'Note: Assumes the report is open.
Dim i As Integer 'Loop controller (group levels.)
Dim lngKt As Long 'Count of matches

Do 'Loop will terminate by error when there are no more group levels.
If rpt.GroupLevel(i).ControlSource Like strText2Match Then
Debug.Print rpt.Name & ".GroupLevel(" & i & "): " & rpt.GroupLevel(i).ControlSource
lngKt = lngKt + 1&
End If
i = i + 1
Loop

Exit_Handler:
FindInGroupLevel = lngKt
Exit Function

Err_Handler:
If Err.Number <> 2464& Then 'No more group levels.
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "FindInGroupLevel()"
End If
Resume Exit_Handler
End Function

Public Function ObjectExists(obj As Object, strObjectName As String) As Boolean
'Purpose: Return True if the named object exists.
'Examples: If ObjectExists(CurrentDb.TableDefs, "Table1") Then
' If ObjectExists(CurrentProject.AllForms, "Form1") Then
Dim varDummy As Variant
On Error Resume Next
varDummy = obj.Item(strObjectName).Name
ObjectExists = (Err.Number = 0&)
End Function

Public Function ControlTypeName(lngControlType As AcControlType) As String
On Error GoTo Err_Handler
'Purpose: Return the name of the ControlType.
'Argument: A Long Integer that is one of the acControlType constants.
'Return: A string describing the type of control.
'Note: The ControlType is a Byte, but the constants are Long.
Dim strReturn As String

Select Case lngControlType
Case acBoundObjectFrame: strReturn = "Bound Object Frame"
Case acCheckBox: strReturn = "Check Box"
Case acComboBox: strReturn = "Combo Box"
Case acCommandButton: strReturn = "Command Button"
Case acCustomControl: strReturn = "Custom Control"
Case acImage: strReturn = "Image"
Case acLabel: strReturn = "Label"
Case acLine: strReturn = "Line"
Case acListBox: strReturn = "List Box"
Case acObjectFrame: strReturn = "Object Frame"
Case acOptionButton: strReturn = "Object Button"
Case acOptionGroup: strReturn = "Option Group"
Case acPage: strReturn = "Page (of Tab)"
Case acPageBreak: strReturn = "Page Break"
Case acRectangle: strReturn = "Rectangle"
Case acSubform: strReturn = "Subform/Subrport"
Case acTabCtl: strReturn = "Tab Control"
Case acTextBox: strReturn = "Text Box"
Case acToggleButton: strReturn = "Toggle Button"
Case Else: strReturn = "Unknown: type" & lngControlType
End Select

ControlTypeName = strReturn

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ControlTypeName()"
Resume Exit_Handler
End Function

Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Purpose: Return true if the object has the property.
Dim varDummy As Variant

On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function




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


VBA Access - Versões do MS Access - até 03.08.2009.

Este número indica a versão do MSAccess.exe. A numeração maior (Por exemplo: 12.0) indica a versão do Office. O número menor (Por exemplo: 6423.1000) indica qual Service Pack foi aplicado. O número talvez seja maior do que o mostrado, caso tenho sido aplicado alguma hotfix, tal como o Service Pack 2 para o  Access 2007, ou kb945674 para o Access 2003.

Os Service packs estão disponíveis a partir do site http://support.microsoft.com/sp. É importante notar que a Microsoft não estende mais suporte ao MS Office 97, mas talvez consiga algum patch here.


MS Access Service Pack Version
97 SR-2 8.0.0.5903
2000 SP-3 9.0.0.6620
2002 SP-3 10.0.6501.0
2003 SP-3 11.0.8166.0
2007 SP-2 12.0.6423.1000


VBA Access - Tipos de arquivos.

Existem inúmeros tipos de arquivos gerados pelas versões do MS Access. Conheça e identifique-as em suas respectivas versões.

Access 97
97 MDB
97 MDE

O Access 97 tem 2 possíveis formatos:

  • MDB (Microsoft Database),
  • MDE (compiled-only database.)

Access 2000
2000 MDB
2000 MDE
2000 ADP
2000 ADE

O Access 2000 usa um formato diferente de MDB e MDE, além de adicionar:

  • ADP (Access Database Project, usado com as tabelas do SQL Server),
  • ADE (compiled-only project.)

Access 2002
2000 MDB
2000 MDE
2000 ADP
2000 ADE
2002/3 MDB
2002/3 MDE
2002/3 ADP
2002/3 ADE

O Access 2002 introduziu o seu próprio formato de storage format, mas continuou suportando bem a versão do Access 2000.

Access 2003
2000 MDB
2000 MDE
2000 ADP
2000 ADE
2002/3 MDB
2002/3 MDE
2002/3 ADP
2002/3 ADE

O Access 2003 usou o formato da versão 2002 (agora chamado como 2002/3), e continuou estendendo suporte a versão 2000.

Access 2007
2000 MDB
2000 MDE
2000 ADP
2000 ADE
2002/3 MDB
2002/3 MDE
2002/3 ADP
2002/3 ADE
2007 ACCDB
2007 ACCDE
2007 ACCDR
2007 ACCDT

O Access 2007 suporta todas as versões do 2000 e 2002/3, e adicionou 4 novos tipos:

  • ACCDB (database based on the new ACE engine), and
  • ACCDE (compiled-only ACE database.)
  • ACCDR (ACCDB or ACCDE limited to runtime)
  • ACCDT (database template)

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

VBA - Retornando nome de usuário logado na máquina.

Cole o código abaixo em um novo módulo e faça referência a atcNames: ? "User: " & atCNames(1) & "- " & Trim(atCNames(2)), Now() Private Declare Function api_GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function api_GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Public Function atCNames(UOrC As Integer) As String ' Author: Date: Contact: ' André Bernardes 06/06/2009 07:23 bernardess@gmail.com ' . 'Purpose: Returns the User LogOn Name or ComputerName 'Accepts: UorC; 1=User, anything else = computer 'Returns: The Windows Networking name of the user or computer On Error Resume Next Dim NBuffer As String Dim Buffsize As Long Dim Wok As Long Let Buffsize = 256 Let NBuffer = Space$(Buffsize) If UOrC = 1 Then Let Wok = api_GetUserName(NBuffer, Buffsize) Let atCNames = Trim$(NBuffer) Else Let Wok = api_GetComputerName(NBuffer, Buffsize) Let atCNames = Trim$(NBuffer) End If End Function
André Luiz Bernardes

A&A: Help - Ajuda quanto a definir o path atual da planilha.

Caro Carlos Toledo,
Boa tarde.

Agradeço primeiramente o contato.

Gostaria que pudesse dizer como encontrou-me,
apenas a título de referência.

Bem, existem algumas formas de resolver o impasse
que me enviou.

1º - poderia forçar que em cada máquina que utilizasse
       a sua planilha, um diretório com a imagem fosse
       instalada.

2º - Pode guardar o path atual da planilha e a partir deste
       sempre enviar a imagem junto com ela para que possa
       carregá-la na sua aplicação.

       Como saber qual o path atual? Simples:

       Let PathNow = ThisWorkbook.Path

Espero tê-lo ajudado.

Sds.

Google Talk: bernardess@gmail.com
Skype: inanyplace
MSN: bernardess@gmail.com

Prezado André, boa tarde!! Preciso de uma ajuda sua!!

Criei uma planilha que na qual dou um click em um OptionButton e através do comando abaixo ele abre uma figura do meu arquivo.

Private Sub OptionButton1_Click()

Image3.Picture = _

LoadPicture("C:\Documents and Settings\e8757050\Desktop\Lay Out\Teste Banco\Vent.bmp")

End Sub

O que ocorre é o seguinte, estou querendo passar essa planilha para outras pessoas, porém quando levo para outro computados, o caminho para as figuras é diferente, por isso não abre nada. São muitas linhas e não dá para trocar o caminho em todas as máquinas.

Gostaria de criar uma forma de que o caminho fosse sempre à pasta na qual está salva a planilha + subpasta "Banco". Ou algo assim!

Como faço???

Favor me ajudar!!!!

Grato,

 Carlos Toledo


VBA Access - Contador de linhas de código.

Provided by Allen Browne, November 2007. Modified January 2008


Contador de linhas (VBA) 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á lista 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 em sua aplicação, crie um novo módulo, e cole este código nele. Então:

  1. Torne o seu código compilado, salvando-o em seguida.
  2. Abra a janela "Immediate Window" (Ctrl+G), e digite:
        ? CountLines()
Option Compare Database
Option Explicit

'Purpose: Count the number of lines of code in your database.
'Author: Allen Browne (allen@allenbrowne.com)
'Release: 26 November 2007
'Copyright: None. You may use this and modify it for any database you write.
' All we ask is that you acknowledge the source (leave these comments in your code.)
' Documentation: http://allenbrowne.com/vba-CountLines.html

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

Google Talk: bernardess@gmail.com
Skype: inanyplace
MSN: bernardess@gmail.com
diHITT - Notícias