✔ Programação GLOBAL®: julho 2009

VBA Excel - Protegendo planilha.

Hello folks...

Invariavelmente vez ou outra decidirá proteger suas planilhas contra o uso inapropriado por
terceiros.

Alguns limitam o uso da planilha por algum tempo, não permitindo que a mesma seja aberta após um período. Outro optam radicalmente pela deleção da planilha inteira.

Como sempre pensamos...Como fazê-lo?

Private Sub Workbook_Open()
             Dim nMess1 as String
             Dim nMess2 as String

             Let ExpDt = #31/07/2009#
             Let nMess1 = "Arquivo expirado. Digite a senha para poder acessá-lo"
             Let nMess2 = "Acesso Negado!"

             If Date > DataExpira Then
                          Let Senha = Application.InputBox(nMess1, "Expirado")

                          If Senha <> 123 Then
                          MsgBox Prompt:=nMess2, Button:=vbOKOnly + vbCritical

                          ThisWorkbook.Close SaveChanges:=False
                          End If
             End If
End Sub

A opção adicional é substituir a linha:

ThisWorkbook.Close SaveChanges:=False

Para deleção completa:

     ThisWorkbook.Saved = True
     ThisWorkbook.ChangeFileAccess xlReadOnly
     Kill ThisWorkbook.FullName
     Application.Quit

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

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

VBA - Definindo a Impressora

Alguns dos nossos relatórios, listas, tabelas, textos, comentários podem ser dirigidos diretamente para algumas impressoras, sem que necessariamente sejam úteis, legíveis ou apropriados.

Podemos definir a impressão de certos relatórios por usuário, impedindo que a impressão ocorra numa impressora colorida por exemplo.

Talvez queira enviar certos relatórios diretamente para uma impressora instalada como driver conversor de PDF. Mas como?

Sub PrintToPDF()
        Dim originalPrinter

        'MsgBox "A impressora ativa no momento é: " & Chr(13) & Chr(13) & Application.ActivePrinter

        Let originalPrinter = Application.ActivePrinter

        'Application.ActivePrinter = "CutePDF Writer on SERV2:"
        'ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:='"CutePDF Writer on SERV2:",                 Collate:=True

        ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="CutePDF Writer on SERV2:",                 Collate:=True

        'Let folder = Environ("Temp")

        Let Filename = Sheet2.Cells(30, 15).Value & ".pdf"
        Let folder = Environ("Temp")
        Let newHour = Hour(Now())
        Let newMinute = Minute(Now())
        Let newSecond = Second(Now()) + 1
        Let waitTime = TimeSerial(newHour, newMinute, newSecond)

        Application.Wait waitTime

        SendKeys Filename

        'MsgBox "A impressora ativa no momento é: " & Chr(13) & Chr(13) & Application.ActivePrinter

        Let Application.ActivePrinter = originalPrinter

        'MsgBox "A impressora ativa no momento é: " & Chr(13) & Chr(13) & Application.ActivePrinter
End Sub

Mas talvez deseje que o usuário escolha a impressora a usar:

        Let nOpt = Application.Dialogs(xlDialogPrinterSetup).Show

        If nOpt = True Then
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Else
            Exit Sub
        End If

Comente e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

VBA Access - Erro 3052 - How to Fix Error 3052

O número de bloqueios de compartilhamento de arquivos foi excedido.

Hello folks!

Vez por outra somos surpreendido por alguns erros nas nossas aplicações MS Access, os quais não fazemos ideia do que sejam (vá se acostumando).

Um dos erros que nos surpreendem, pegando-nos desprevenidos, é o erro 3052 ele aparece quando o número de bloqueios de compartilhamento de arquivos foi excedido, o valor padrão é 9.500. Sem nos apercebermos disso, excedemos o número máximo de bloqueios permitidos em um recordset, este limite é especificado pela definição MaxLocksPerFile no Registro do sistema.

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines\Jet
4.0\MaxLocksPerFile

Como eliminá-lo? Aumente a entrada de registro MaxLocksPerFile, o valor padrão pode ser alterado por meio da edição do Registro com Regedit.exe ou com o método SetOption.

Application.DBEngine.SetOption dbMaxLocksPerFile, <NumLocks>

Altere o <NumLocks> para 1000000 ou algo maior do que 10000 (um milhão poupará você de aplicar esse truque mais vezes) e o erro irá embora. Certifique-se de colocar a linha acima na sua subroutina, e evoque-a a partir do seu FORM principal.

  15.01.2025

Aqui está um exemplo de código para lidar com o Erro 3052 no VBA, com melhorias e comentários explicativos. O erro 3052 no Access geralmente ocorre quando o número máximo de objetos no banco de dados é excedido, ou seja, quando se atinge o limite de objetos no banco de dados (como tabelas, consultas, formulários, etc.).

Option Explicit

' Função para corrigir o Erro 3052 - Limite de objetos do banco de dados excedido
Sub FixError3052()
On Error GoTo Err_Handler

' Tentativa de acessar ou criar um novo objeto (por exemplo, uma tabela ou consulta)
Dim db As DAO.Database
Dim obj As DAO.TableDef
Set db = CurrentDb()

' Exemplo de tentativa de criação de uma nova tabela (alterar conforme necessidade)
Set obj = db.CreateTableDef("NewTable")

' Código para realizar operações com o objeto (como adicionar campos, etc.)
' Exemplo:
' obj.Fields.Append obj.CreateField("FieldName", dbText)

' Caso a criação da tabela seja bem-sucedida, a execução segue normalmente
db.TableDefs.Append obj

' Limpeza e liberação de recursos
Set obj = Nothing
Set db = Nothing

' Mensagem informando que a operação foi bem-sucedida
MsgBox "Novo objeto criado com sucesso!", vbInformation

Exit Sub

Err_Handler:
' Se o erro 3052 ocorrer, exibe uma mensagem personalizada explicando o erro
If Err.Number = 3052 Then
MsgBox "Erro 3052: O limite de objetos no banco de dados foi atingido." & vbCrLf & _
"Por favor, remova objetos desnecessários ou compacte o banco de dados para liberar espaço.", _
vbCritical, "Erro de Limite de Objetos"
Else
' Exibe uma mensagem para outros erros
MsgBox "Erro não esperado: " & Err.Description, vbCritical, "Erro"
End If

' Limpeza e liberação de recursos em caso de erro
Set obj = Nothing
Set db = Nothing
End Sub

Outros fatores que podem fazer o seu aplicativo atingir este limite são:

quantidade de memória disponível
tamanho das linhas no recordset
restrições no sistema operacional da rede

Mais detalhes: Inicializando o driver de mecanismo de banco de dados do Microsoft Jet 3.5
Personalizando configurações do Registro do Windows para Microsoft Jet

Pois é, desse erro você já se livrou . . . Mas . . . outros virão...

Clique aqui e nos contate via What's App para avaliarmos seus projetos

Envie seus comentários e sugestões e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

Série de Livros nut Project

DONUT PROJECT: VBA - Projetos e Códigos de Visual Basic for Applications (Visual Basic For Apllication)

eBook - DONUT PROJECT 2024 - Volume 03 - Funções Financeiras - André Luiz Bernardes

eBook - DONUT PROJECT 2024 - Volume 02 - Conectando Banco de Dados - André Luiz Bernardes

eBook - DONUT PROJECT 2024 - Volume 01 - André Luiz Bernardes

PUDIM PROJECT

VBA Access - colocando título na sua aplicação - How to Add a Title to Your Application

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

- O nome da aplicação
- A ação efetuada no momento por sua aplicação
- O nome da sua empresa
- Código do processamento sendo efetuado no momento.

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

' Digite num novo módulo:

Option Explicit
Option Compare Database

Private Declare Function SetWindowText _
Lib "user32" _
Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Public Sub SetFormTitle(frm As Form, TitleText As String)
    Dim fhWnd As Long
    fhWnd = frm.hwnd
    SetWindowText fhWnd, TitleText
End Sub

'Copie a SUB abaixo dentro do formulário, no evento OnOpen.
Private Sub Form_Open(Cancel As Integer)
SetFormTitle Me, ".: A&A - In Any Place - Título da minha aplicação!"
End Sub

  15.01.2025

Option Explicit

Option Compare Database

' Declaração da função API para alterar o título da janela de um formulário

Private Declare Function SetWindowText _

                Lib "user32" _

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

' Função pública para definir o título da janela do formulário

' Esta função usa a API SetWindowText para alterar o título da janela de um formulário.

' Parâmetros:

' - frm: O formulário cujo título será alterado.

' - TitleText: O texto que será exibido no título da janela do formulário.

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

    ' Declara variável para armazenar o identificador da janela do formulário

    Dim formHandle As Long

    ' Obtém o identificador da janela (HWND) do formulário

    formHandle = frm.hwnd

    ' Chama a função da API para alterar o título da janela

    SetWindowText formHandle, TitleText

End Sub

' Este evento é executado ao abrir o formulário.

' Coloque este código no evento "OnOpen" do formulário para definir o título personalizado.

Private Sub Form_Open(Cancel As Integer)

    ' Define o título do formulário com um texto personalizado.

    ' O texto pode ser alterado conforme necessário para refletir o título da aplicação ou outros detalhes.

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

End Sub

Clique aqui e nos contate via What's App para avaliarmos seus projetos

Envie seus comentários e sugestões e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

Série de Livros nut Project

PUDIM PROJECT

VBA Powerpoint - Dicas...

VBA Powerpoint: Populando LISTBOX a partir do Access.
VBA Powerpoint: Torne homogêneas todas as fontes e cores.

André Luiz Bernardes

VBA Word - Várias dicas.

Dicas de Word

VBA Word - Retire todos hyperlinks mantendo o texto no .DOC
VBA Word - Alteração de texto com base em opção em drop-down
VBA Word - Checando número de revisões ao abrir
VBA Word - Como listar todas as Macros no meu documento.
VBA Word - Várias Funções.
VBA Word - Instale uma macro em VBA na barra de acesso rápido do Word
VBA Word - Numerador automático de documentos

André Luiz Bernardes

VBA Outlook - Várias dicas.

VBA Outlook - Eliminar mensagem de alerta no Outlook
VBA Outlook - 06 - Uso do editor do Word no outlook.
VBA Outlook - 05 - Criando tarefas a partir de um e-mail.
VBA Outlook - 04 - Arquivos anexados.
VBA Outlook - 03 - Mensagens em uma pasta específica
VBA Outlook - 02 Enviando lembretes.
VBA Outlook - 01 - Iniciando
VBA Outlook - Inserindo Assinatura programaticamente.
VBA Outlook 01 - Enviando mensagem sem interrupções.
VBA Outlook - Reencaminhar mensagens enviadas como ocultas.

André Luiz Bernardes

VBA - Várias Dicas para diversas aplicações

Diversas dicas em várias aplicações VBA

Apagar ficheiros
VBA Office: Controlando aplicativo Office a partir de outro.
controlo windowsmediaplayer
Escolher qual impressora p/ imprimir
Browser
VBA - Menu no Formulário
Problema com Label
Gravando uma aba para uma planilha.
Livros: VBA
Janelas em VB
Gestor de tarefas
VBA - design
Gifs no VB 6.0
VBA com DOS: Execute comandos a partir das aplicações VBA.
Impressão em Argox os 214
VBA - Winzip com VBA
10 Dicas para gerenciar um projeto.
Condições para ativa e desativar botão
Pesquisas em Form por Data
macro find e deletar linha
Como imprimir hiperlinks de várias células
Tabela editável parecido com listbox
VBA - Código para converter segundos em h:m:s
VBA - comparação entre colunas
VBA - excluindo linhas duplicadas - Em coluna ordenada.
VBA - controle interrupções
VBA - Boa definição ao pedir ajuda.
Imagens GIF em movimento
Redimensionamento automático de uma imagem
Erro ao executar F5 em VBA
Trabalhando com área de transferência em VBA
VBA - História
Procurando Valores pelo VBA
Diferenca duas datas com horas sem fim de semana
Usando índices em VBA
Lista de Compras
Ajuda
Pensando o VBA
VBA - Origem
Buscar palavras com VBA
Controle de estoques no VBA
Manual de Visual Basic Simples
VBA - Controles ActiveX - caixas de texto.
Dica: Converter texto para maiúsculos ou minúsculos
VBA - Diversos códigos e soluções prontos para utilização
VBA Desenvolvimento: Profissionalizando minhas soluções

André Luiz Bernardes

VBA Access - Índice - Creating and Using Indexes

Várias dicas interessantes...

  15.01.2025

Option Explicit

' Função para criar um índice em uma tabela do Access
Public Sub CreateIndex()
On Error GoTo ErrorHandler

' Definindo variáveis para a tabela e o índice
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim idx As DAO.Index
Dim fld As DAO.Field

' Obtendo o banco de dados atual
Set db = CurrentDb

' Definindo a tabela onde o índice será criado
Set tdf = db.TableDefs("MinhaTabela") ' Substitua "MinhaTabela" pelo nome real da tabela

' Verificando se o índice já existe para evitar duplicação
On Error Resume Next
Set idx = tdf.Indexes("IDX_Nome") ' Substitua "IDX_Nome" pelo nome do índice
On Error GoTo ErrorHandler

If Not idx Is Nothing Then
MsgBox "Índice já existe. Nenhuma ação realizada.", vbExclamation, "Aviso"
Exit Sub
End If

' Criando um novo índice
Set idx = tdf.CreateIndex("IDX_Nome") ' Nome do índice
idx.Unique = False ' Define se o índice será único (True ou False)
idx.Primary = False ' Define se o índice será uma chave primária (True ou False)

' Adicionando campos ao índice
Set fld = idx.CreateField("Campo1") ' Substitua "Campo1" pelo nome do campo da tabela
idx.Fields.Append fld ' Adiciona o campo ao índice

' Caso queira adicionar mais campos ao índice, use:
' Set fld = idx.CreateField("Campo2") ' Adicione outros campos conforme necessário
' idx.Fields.Append fld

' Adicionando o índice à tabela
tdf.Indexes.Append idx

' Confirmando a criação do índice
MsgBox "Índice 'IDX_Nome' criado com sucesso.", vbInformation, "Sucesso"

' Finalizando
Exit Sub

ErrorHandler:
' Exibe uma mensagem de erro caso algum problema ocorra
MsgBox "Erro Nº: " & Err.Number & "; Descrição: " & Err.Description, vbCritical, "Erro"
Set idx = Nothing
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Sub

' Função para demonstrar o uso do índice na consulta
Public Sub UseIndexInQuery()
On Error GoTo ErrorHandler

' Definindo a variável para a consulta SQL
Dim strSQL As String

' Consulta utilizando o índice criado
strSQL = "SELECT * FROM MinhaTabela WHERE Campo1 = 'AlgumValor'" ' Substitua com sua consulta real

' Executando a consulta com o índice
CurrentDb.Execute strSQL, dbFailOnError

MsgBox "Consulta executada utilizando o índice.", vbInformation, "Sucesso"

Exit Sub

ErrorHandler:
' Exibe uma mensagem de erro caso algum problema ocorra
MsgBox "Erro Nº: " & Err.Number & "; Descrição: " & Err.Description, vbCritical, "Erro"
End Sub