VBA Access - Removendo campos programaticamente

Remove Fields From MDB programmatically O código VBA abaixo será usado para remover um campo de uma tabela do MS Access através da codificação VBA. Sobre a função: Aceitará três parâmetros 1. Database Path - O caminho completo da base de dados MS Access 2. TableName - O nome correto da tabela do MS Access de onde o campo será removido. 3. FieldName - O nome do campo a ser removido.

Function RemoveFieldFromMSACCESSTable (ByVal AccessDBPath, _                                        ByVal AccessTableName As String, _                                        AccessFieldName As String _                                       ) As Boolean   ' Declaração das variáveis.   Dim AccessDB As Database   Dim AccessDBPath As Variant   Dim Td As TableDef   On Error Resume Next   ' Informa o Path do MS Access DB, baseado na TableName.   ' Abre a base de dados.   Set AccessDB = OpenDatabase(AccessDBPath) 'if linked table          If Err <> 0 Then                ' Caso falhe, retorna a base de dados.     Exit Function          End If      ' Retorna a tabela.      Set Td = AccessDB.TableDefs(AccessTableName)      If Err <> 0 Then            ' caso falhe obtém a tabela.            GoTo End      End IF   ' Deletando o campo.   With Td            ' Deleta o campo.            .Fields.Delete AccessFieldName            If Err <> 0 Then                  ' Caso falhe a deleção do campo - possivelmente não existe.                  GoTo End            End If      End With      Let RemoveFieldFromMSACCESSTable = True ' O Default é False caso tenha falhado.   ' Limpa. End:      Set Td = Nothing      ' Close the Database      If Not AccessDB Is Nothing Then AccessDB.Close      Set AccessDb = Nothing End Function

Exemplo do uso:

Public Sub RemoveField () ' Exemplo da chamada: If (RemoveFieldFromMSACCESSTable ( "C:\Bernardes\A&A.mdb", "Clientes", "TimeStamp") Then MsgBox "Campo removido com sucesso!" End If End Sub

 

A chamada acima é utilizada para excluir de "C:\Bernardes\A&A.mdb", o nome da tabela é Clientes, e o nome do campo é "TimeStamp"

 

 

Twitter: @officespecialis

             @brzexceldevelop

             @brzaccessdevel

Veja também: Blog Office VBA

Blog Excel

Blog Access

André Luiz Bernardes bernardess@gmail.com http://al-bernardes.sites.uol.com.br/

VBA Access - Função para saber se existe um arquivo.

Tudo bem que seja uma função básica, mas com sua utilidade.

Esta função retorna True se não houver um arquivo com o nome que você passar, mesmo que esteja escondido ou seja um arquivo de sistema.

Assume o diretório atual, se você não incluir um caminho.

Retorna False se o nome do arquivo for uma pasta, a menos que você passe True para o segundo argumento.

Retorna False para qualquer erro, por exemplo: nome de arquivo inválido, a permissão foi negada, o servidor não foi encontrado.

Procura um arquivo chamado nFile.accdb na pasta de dados: ExisteArquivo ("C: \ Data \ nFile.accdb")

Procura um arquivo chamado nFile.txt em um servidor de rede: ExisteArquivo ("\ \ MyServer \ MyPath \ nFile.txt")

Verifique se há um arquivo ou pasta no servidor com o nome Bernardes: ExisteArquivo ("\ \ MyServer \ Bernardes", True)

Verifica a pasta do banco de dados atual para um arquivo chamado A&A-InAnyPlace.xlsx: ExisteArquivo (TrailingSlash (CurrentProject.path) & "A&A-InAnyPlace.xlsx")

Function ExisteArquivo (ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean     Dim lngAttributes As Long

    'Inclui arquivos read-only (somente leitura), hidden (escondidos), e system (de sistema).     Let lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)

    If bFindFolders Then         Let lngAttributes = (lngAttributes Or vbDirectory) 'Inclui pastas.     Else         Do While Right$(strFile, 1) = "\"             Let strFile = Left$(strFile, Len(strFile) - 1)         Loop     End If

    ' Se Dir() retornar alguma coisa, é porque existem arquivos.     On Error Resume Next     Let FileExists = (Len(Dir(strFile, lngAttributes)) > 0) End Function

Function TrailingSlash (varIn As Variant) As String     If Len(varIn) > 0 Then         If Right(varIn, 1) = "\" Then             Let TrailingSlash = varIn         Else             Let TrailingSlash = varIn & "\"         End If     End If End Function

 

Twitter: @officespecialis              @brzexceldevelop              @brzaccessdevel

Veja também: Tudo em VBA VBA Excel VBA Access

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

VBA Excel - Trabalhado com múltiplas WorkSheets - 02

Selecionando várias worksheets Vejamos um exemplo de como construir uma matriz com os elementos identificados apenas em tempo de execução. Mas, primeiro nós olhamos o código que usa a declaração SELECT de uma forma raramente vista. Sabia que o método Select tem um parâmetro opcional? Verifique o Help do MS Excel VBA e encontrará a sintaxe Selecione o método que se aplica para o Chart, Charts, Shape, ShapeRange, Sheets, Worksheet, e objetos Worksheets.

Selecione o objeto. expression.Select(Replace) A expressão requer uma expressão que retorne um dos objetos acima (Chart, Charts, Shape, ShapeRange, Sheets, Worksheet, e objetos Worksheets). Replace É uma Variant opcional  O exemplo de código abaixo seleciona os Sheet2 Chart1, copiando-os para um novo workbook.

 

Sheets ( "Sheet2"). Selecione Sheets ( "Chart1"). Selecione False ActiveWindow.SelectedSheets.Copy

 

Como comentei anteriormente, a seleção e ativação dos objetos deve ser utilizada como último recurso. Veremos como fazer isso em seguida.... Twitter: @officespecialis @brzexceldevelop @brzaccessdevel Veja também: Blog Office VBA | http://inanyplace.blogspot.com/ Blog Excel | http://brzexceldeveloper.blogspot.com/ Blog Access | http://brzaccessdeveloper.blogspot.com/

VBA Excel - Trabalhado com múltiplas WorkSheets

Termo de Responsabilidade 

Hello folks!

Existem diversos casos nos quais desejemos realizar uma única e mesma ação em várias worksheets simultaneamente. Isso pode incluir imprimi-las ou copiá-los para outro local ou mesmo editá-las em suas várias worksheets numa única etapa.

Em alguns casos processar uma worksheet de cada vez produzirá um resultado diferente do que se pode obter ao trabalhar em várias worksheets ao mesmo tempo. Em outros casos, pode ser apenas uma questão de conveniência.

De qualquer modo no seu caso pode ser apenas uma questão de aprendizado de como fazê-lo.

Dois exemplos onde os resultados são diferentes:


Quando se copia um gráfico, e os dados associados a este, num único processo para outra pasta de trabalho, as referências ao gráfico também são atualizadas, fazendo referência aos dados da nova pasta. No entanto, se estas são copiados individualmente, o gráfico faria referência à worksheet original.


Outro exemplo pode ser observado no momento da impressão simultânea de várias worksheets, ao imprimi-las as páginas serão numeradas sequencialmente. Faça isso uma folha de cada vez e as páginas serão numeradas separadamente. Além disso, cada folha será um trabalho de impressão separado. Enquanto alguns podem não considerar isto como um grande problema, para outros pode ser.

Nesta dica veremos como trabalhar com várias sheets. 

Usando o gravador de macro 
Começando com o nosso amigo de confiança, o gravador de macro, temos a impressão de duas folhas:

Dim nPlan As String 
Dim nChart As String 
Dim nSheet As String

Sheets (Array ( nPlan, nChart)). Selecione 
Sheets ( nSheet). Activate


Let Application.ActivePrinter = "HP-Printer on Ne01:"


ActiveWindow.SelectedSheets.PrintOut Copies: = 1, ActivePrinter: = "Acrobat Distiller Ne06 em:", Collate: = True

Observe que o código utiliza essencialmente uma matriz com um índice para o endereçamento (Sheets(1)), ao invés da típica sintaxe Sheets("Sheet1"). Isso permitirá o funcionamento em várias worksheets ao mesmo tempo.

Referências: 

Tags: VBA, Excel, Sheet, simultâneo, 

Access VBA - API: Alterando as propriedades ForeColor e Bold num nó selecionado de um Treeview

API: Alterando as propriedades ForeColor e Bold no NÓ selecionado de um Treeview:

Bem, para ser sincero com vocês o controle TreeView da Microsoft não suporta nenhum realce no texto de um NÓ que esteja selecionado.

Embora você possa destacar (highlight) um NÓ através da execução de um código no evento Click, o NÓ previamente destacado (highlighted) perderá tal destaque.

Para que possa testar este exemplo, coloque um Treeview (refiro-me a versão 6), sobre um formulário e, com o nome tvwTest-lo. Copie o seguinte código abaixo no módulo de classe do formulário.

Usando a API SendMessage, será possível recuperar as configurações atuais de um NÓ, e para repetir todos os NÓS, se a propriedade Bold for definida como verdadeira para um NÓ, pode forçar o NÓ para ser redefinido,  redesenhando-o normalmente.

Private Type TV_ITEM
    mask As Long
    hItem As Long
    state As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As Long
End Type
 
Private Declare Function apiSendMessage _
    Lib "user32" Alias "SendMessageA" _
  (ByVal hWnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) _
  As Long
 
Private Const TVIS_BOLD  As Long = &H10
Private Const TV_FIRST As Long = &H1100
Private Const TVM_GETITEM As Long = (TV_FIRST + 12)
Private Const TVIF_HANDLE = &H10
Private Const TVGN_ROOT = &H0

Private Const TVIF_CHILDREN = &H40
Private Const TVM_GETNEXTITEM = (TV_FIRST + 10)
Private Const TVGN_CHILD = &H4
Private Const TVIF_STATE = &H8
Private Const TVM_SETITEM = (TV_FIRST + 13)
Private Const TVGN_NEXT = &H1

Private Const TVGN_CARET = &H9
Private mobjLastNode As Node
Private mlngBackColor As Long
 
Private Sub Form_Load()
    Dim objNode As Node
    Dim i As Integer

    For i = 1 To 10
        Set objNode = tvwTest.Nodes.Add(, , "r" & i, "ANode" & i)
    Next
End Sub
 
Private Sub sResetItems _
(hWnd As Long, hItem As Long)

Dim tvi As TV_ITEM
Dim hItemChild As Long
Dim objNode As Node
 
    If hItem = 0 Then
        Let hItem = apiSendMessage(hWnd, _
                            TVM_GETNEXTITEM, _
                            TVGN_ROOT, _
                            ByVal 0&)
    End If

    If Not mobjLastNode Is Nothing Then
        With mobjLastNode
            Let .ForeColor = vbBlack
            Let .BackColor = mlngBackColor
        End With
    End If

    Do While Not hItem = 0
        Let tvi.hItem = hItem
        Let tvi.mask = TVIF_CHILDREN Or TVIF_STATE
        Let tvi.stateMask = TVIS_BOLD

        Call apiSendMessage(hWnd, _
                    TVM_GETITEM, _
                    0, _
                    tvi)
        If tvi.state And TVIS_BOLD = TVIS_BOLD Then
            Let tvi.state = tvi.state And Not TVIS_BOLD
            Call apiSendMessage( _
                hWnd, _
                TVM_SETITEM, _
                0, _
                tvi)
        End If

        If (tvi.cChildren) Then
            Let hItemChild = apiSendMessage( _
                        hWnd, _
                        TVM_GETNEXTITEM, _
                        TVGN_CHILD, _
                        ByVal hItem)

            Call sResetItems(hWnd, hItemChild)
        End If

        Let hItem = apiSendMessage (hWnd, _
                                    TVM_GETNEXTITEM, _
                                    TVGN_NEXT, _
                                    ByVal hItem)
    Loop
End Sub

Private Sub tvwTest_NodeClick _
(ByVal Node As Object)

   Call sResetItems(Me.tvwTest.hWnd, 0)

    With Node
        Let .Bold = True
        Let .ForeColor = vbBlue
        Let mlngBackColor = .BackColor
        Let .BackColor = vbYellow
    End With

    Set mobjLastNode = Node
End Sub

Developed by Dev Ashish

Veja também:
Tudo em VBA
VBA Excel
VBA Access

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