Visual Basic em Português

Página pessoal de Jorge Paulino sobre o Visual Basic (VB.NET, ASP.NET, VB6, VBA) e algumas noticias de tecnologia

Excel: Microsoft Scripting Runtime

29 agosto 2008 Tags: , , 10 comentários

O Microsoft Scripting Runtime está incluído em diversos programas do Windows, como é o caso do Office e do próprio sistema operativo, e permite um fácil acesso a ficheiros e pastas, bem como simplifica o acesso de leitura e escrita de ficheiros de texto.

Por ser uma ferramenta disponível no sistema operativo pode ser usada por o Excel (VBA) mas também por outras aplicações que utilizem VBA (Access, Word, Outlook, etc) ou pelo Visual Basic 6.

O Microsoft Scripting Runtime tem 6 objectos que podem ser usados com bastante simplicidades: Dictionary (criação de colecções); Drive (acesso às drives do sistema); File (acesso a ficheiros); FileSystemObject (objecto base para acesso a drives, pastas e ficheiros); Folder (acesso a pastas) e TextStream (leitura e escrita em ficheiros de texto).

No seguinte exemplo serão utilizados apenas alguns objectos para mostrar como aceder a todos os ficheiros, com base em uma pasta inicial e suas sub-pastas, e listar seus nomes e alguns dados adicionais. 

Para implementar o exemplo é apenas necessário adicionar referência no VBE (Visual Basic Editor) ao Microsoft Scripting Runtime através do menu Tools - References e utilizar o seguinte código:

 

    Option Explicit

    ' Cria uma nova instância do FileSystemObject
    Private fso As New FileSystemObject

    ' Declaração de variáveis
    Private sFolder As Scripting.Folder
    Private myFile As Scripting.File
    Private myFolder As Scripting.Folder
    Private pos As Long

    ' --------------------------------------------------------------------
    ' Sub auxiliar que lista os ficheiros nas sub-pastas
    ' --------------------------------------------------------------------
    Sub ShowSubFolderFiles(ByVal folderName As String)

        ' Ignora erros em pastas protegidas, pastas de sistema, etc
        On Error Resume Next

        Set sFolder = fso.GetFolder(folderName) 

        ' Ciclo em todas as pastas 
        For Each myFolder In sFolder.SubFolders

        ‘ Ciclo em todos os ficheiros
            For Each myFile In myFolder.Files
                Cells(pos, 1).Value = myFile.Path
                Cells(pos, 2).Value = myFile.DateCreated
                Cells(pos, 3).Value = myFile.Size & " bytes"
                Cells(pos, 4).Value = myFile.Type
                Cells(pos, 5).Value = myFile.DateLastAccessed
                pos = pos + 1
            Next

            ' Recursividade: Caso a pasta tenha sub-pastas chama novamente
            ' o mesmo código - Sub ShowSubFolderFiles()
            If myFolder.SubFolders.Count > 0 Then
                ShowSubFolderFiles myFolder.Path
            End If 

        Next

    End Sub

 

    ' --------------------------------------------------------------------
    ' Sub principal que inicia o processo de listagem de
    ' todos os ficheiros, com base numa pasta inicial
    ' --------------------------------------------------------------------
    Sub ShowFolderFiles()
        Dim initialFolder As String 

        ' Ignora erros em pastas protegidas, pastas de sistema, etc
        On Error Resume Next

        ' Pasta inicial e linha da folha de cálculo onde será 
        ' iniciada a escrita dos ficheiros encontrados
        initialFolder = "C:\"
        pos = 1 

        ' Verifica se a pasta indicada existe
        If Not fso.FolderExists(initialFolder) Then
            MsgBox "A pasta " & initialFolder & " não existe!", vbCritical
            Exit Sub
        End If

        ' Define a pasta inicial
        Set sFolder = fso.GetFolder(initialFolder)

        ' Mostra os ficheiros na pasta inicial
        ' incrementado a posição (linha) onde escreve
        For Each myFile In sFolder.Files
            Cells(pos, 1).Value = myFile.Path
            Cells(pos, 2).Value = myFile.DateCreated
            Cells(pos, 3).Value = myFile.Size & " bytes"
            Cells(pos, 4).Value = myFile.Type
            Cells(pos, 5).Value = myFile.DateLastAccessed
            pos = pos + 1
        Next

        ' Mostra os ficheiros nas sub-pastas
        Call ShowSubFolderFiles(sFolder.Path)

        ' Limpa as variáveis da memória
        Set fso = Nothing
        Set myFolder = Nothing
        Set myFile = Nothing

    End Sub

 

Finalmente para testar o nosso código basta ir ao menu Tools – Macro – Macros (ALT+F8) e escolher a macro ShowFolderFiles(). Poderá, obviamente, ser utilizada através de um botão, menu, etc.

O seguinte exemplo mostra como listar ficheiros numa folha de cálculo mas o objectivo é mostrar as potencialidades desta biblioteca e como se podem fazer algumas operações.

Podem ser criados pastas, eliminados ficheiros, verificar se determinado ficheiros existe, escrever em ficheiros de texto, etc etc, de uma forma muito mais simples e sem o recurso a API’s ou códigos demasiado complicados.

PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!


VB.NET: Criação de Classes COM Interop (VB6)

20 agosto 2008 Tags: , , 3 comentários

Os programadores que utilizam VB6 e .Net certamente já disseram, quando estavam a programar em VB6, “Se isto fosse em .NET … era muito mais fácil!”. A verdade é que o .Net simplificou muitos processos, graças à plataforma .Net Framework e às suas classes.

Então se temos o .NET Framework instalado porque não a utilizamos?

É bastante simples de o fazer construindo classes COM Interop. Deste modo podemos utilizar no VB6 as potencialidades do .Net Framework, como por exemplo, enviar emails, encriptação, gestão de ficheiros, XML, compactação de ficheiros, etc, etc.            

Para mostrar como utilizar as classes COM Interop no VB6 irá ser mostrado um pequeno exemplo utilizando o Namespace IO do VB.Net. Este exemplo irá apagar todos os ficheiros num directório indicado, com uma determinada máscara. No VB6 este processo é muito mais complicado sendo necessário percorrer todos os directórios e verificar quais os ficheiros que cumprem os requisitos para serem eliminados.

Para construir o nossa classe COM Interop fazer então o seguinte:

VB.NET

1 – Criar um novo projecto e seleccionar Class Library e alterar o nome para myComProject


2 – Eliminar a classe automaticamente criada “Class1.vb”


3 – Adicionar um novo item do tipo COM Class e alterar o nome para myComClass


Após isto o Visual Studio faz algumas configurações no nosso projecto e cria algum código na classe.

4 – Adicionar o Sub DeleteFiles (apenas adicionar este novo Sub e manter o restante). No final ficará com este aspecto:

<ComClass(myComClass.ClassId, myComClass.InterfaceId, myComClass.EventsId)> _
Public Class myComClass

#Region "COM GUIDs"
    ' These  GUIDs provide the COM identity for this class 
    ' and its COM interfaces. If you change them, existing 
    ' clients will no longer be able to access the class.
    Public Const ClassId As String = "0c6277bf-5e39-4682-8027-18b62c82ee6f"
    Public Const InterfaceId As String = "154cdcef-f13f-4af2-82c8-fc6de1e74a7d"
    Public Const EventsId As String = "07420108-f1c9-4b36-adbc-1373035429f7"
#End Region

    ' A creatable COM class must have a Public Sub New() 
    ' with no parameters, otherwise, the class will not be 
    ' registered in the COM registry and cannot be created 
    ' via CreateObject.
    Public Sub New()
        MyBase.New()
    End Sub

    ''' <summary>
    ''' Apaga todos os ficheiros numa determinada localização
    ''' </summary>
    ''' <param name="filePath">Directório a procurar</param>
    ''' <param name="filePattern">Máscara a eliminar</param>
    ''' <remarks></remarks>
    Public Sub DeleteFiles(ByVal filePath As String, ByVal filePattern As String)

        Try

            ' Verifica se o directório existe
            If Not IO.Directory.Exists(filePath) Then
                Throw New ArgumentException("A caminho indicado não é válido")
                Exit Sub
            End If

            ' Elimina os ficheiros de acordo com a máscara seleccionada
            Dim files() As String = IO.Directory.GetFiles(filePath, filePattern)
            For Each myfile As String In files
                IO.File.Delete(myfile)
            Next

        Catch ex As Exception
            Throw New ArgumentException(ex.Message)
        End Try

    End Sub

End Class


5 – Gravar e compilar o Projecto. Irá então ser criado um novo DLL.

VB6

6 – Abrir o VB6 e criar um novo projecto "Standard EXE"

7 – Ir ao menu Project – References e adicionar o *.tlb, que se encontra na pasta Bin\Release\, da nossa classe COM criada. Atenção: o ficheiro myComProject.tlb e não o myComProject.dll

8 – Adicionar um botão o Form e no evento click colocar o seguinte código:

    Private Sub Command1_Click()           

        ' Cria uma nova instância da nossa classe
        Dim cls As New myComClass           

        ' Apaga todos os ficheiros no directório d:\test que tenham a extensão txt
        cls.DeleteFiles "d:\test", "*.txt"

    End Sub

Como podem ver após este exemplo, é utilizar as potencialidades da plataforma .NET no Visual Basic 6. Esta funcionalidade permite, além de simplificar muito código, utilizar funções que só se conseguiam através do VB.NET.


VB.NET: Dicas de Programação #8

14 agosto 2008 Tags: , 1 comentários

Movimentação de Controlos em Run-Time

Quando é necessário movimentar controlos com o rato, existem diferentes códigos que necessitam de cálculos, variáveis, etc, de modo a arrastar o controlo de um lugar para o outro, enquanto o botão do rato estiver pressionado.

Se é verdade que não é muito utilizado é verdade que quando é preciso não é um processo muito simples de fazer (pelo menos dá algum trabalho).

A forma mais simples de o fazer (que eu tenha conhecimento) é utilizando o método DefWndProc() que permite enviar mensagens para o sistema. É uma utilização de subclasses que irá fazer o mesmo que o Windows faz quando o utilizador pressiona o rato na barra de título e arrasta-o.

Ora isto permite simplificar uma série de coisas como arrastar um controlo (como por exemplo uma Label ou TextBox) ou mesmo o próprio Form. No caso do Form, e quando este não tem barra de titulo, dá imenso jeito.

Dois exemplos para uma TextBox e o Form

    ' Constantes com a indicação de que o utilizador pressiona 
    ' o botão esquerdo do rato e da barra de titulo do Form
    Const WM_NCLBUTTONDOWN As Integer = &HA1
    Const HTCAPTION As Integer = 2

    ' Movimentação da TextBox no Form
    Private Sub TextBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles TextBox1.MouseDown

        ' Caso esteja a ser pressionado o botão esquerdo
        If e.Button = Windows.Forms.MouseButtons.Left Then

            ' Liberta a captura do rato. Esta captura vai a True
            ' quando o rato é pressionado, e impede a movimentação
            TextBox1.Capture = False

            ' Envia uma mensagem que irá movimentar o controlo
            Dim msg As Message = _ 
                  Message.Create(TextBox1.Handle, WM_NCLBUTTONDOWN, _
                            New IntPtr(HTCAPTION), IntPtr.Zero)
            Me.DefWndProc(msg)
        End If

    End Sub

   

    ' Movimentação do From (sem comentários uma vez que é igual ao anterior)
    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown

        If e.Button = Windows.Forms.MouseButtons.Left Then
            Me.Capture = False
            Dim msg As Message = _
                       Message.Create(Me.Handle, WM_NCLBUTTONDOWN, _
                      New IntPtr(HTCAPTION), IntPtr.Zero)
            Me.DefWndProc(msg)
        End If

    End Sub


É possível ainda utilizar outras constantes para fazer outras acções, como por exemplo utilizando a HTBOTTOMRIGHT (Const HTBOTTOMRIGHT As Integer = 17) em vez da HTCAPTION, que irá efectuar o resize do Form. A constante HTBOTTOMRIGHT é a indicação de que o utilizador está a fazer o redimencionamento do Form no canto inferior direito.





Manter posição da DataGridView após ordenação

A DataGridView permite ordenar os seus dados de uma forma automática, bastando para isso clicar nos cabeçalhos das colunas. É sem dúvida muito prático e sem recorrer a qualquer código (por parte do utilizador). O que não é prático é que a lista perde a selecção após ordenação, ou seja, após a lista ser ordenada pela coluna X, a selecção actual perde-se.

Para resolver este problema pode-se criar uma walkaround onde é guardado um identificador único da lista (no exemplo um ID) e a índex da coluna. Desta forma é possível ordenar a lista e manter a selecção actual.

    ' Variável que irá guardar a informação do ID seleccionado
    Private currentRowID As Integer

    ' Variável que irá guardar a informação da coluna seleccionada
    Private currentCellIndex As Integer

   

    ''' <summary>
    ''' Pesquisa na lista pelo ID e retorna o index da linha encontrada
    ''' </summary>
    ''' <param name="ID">Número único da lista (ID)</param>
    Function getDGindex(ByVal ID As Integer) As Integer
        Dim dr As DataGridViewRow

        For Each dr In DataGridView1.Rows
            If CType(dr.Cells(0).Value, Integer) = ID Then
                Return dr.Index
            End If
        Next

    End Function

    ' No arranque do form carrega alguns dados para o exemplo
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        ' Criação de uma nova datatable que 
        ' irá servir para preencher a DataGridView
        Dim dt As New DataTable

        ' Criação de algumas colunas
        dt.Columns.Add("ID", GetType(Byte))
        dt.Columns.Add("Description", GetType(String))
        dt.Columns.Add("Random", GetType(Integer))

        ' Criação de um número aleatório
        Dim rnd As New Random
        Dim dr As DataRow   

        ' Insere registos na DataTable
        For x As Byte = 0 To 100
            dr = dt.NewRow
            dr("ID") = x
            dr("Description") = "Item " & x.ToString.PadLeft(3, "0"c)
            dr("Random") = rnd.Next(0, 1000)
            dt.Rows.Add(dr)
        Next

        ' Associa a DataTable à source da DataGridView
        Me.DataGridView1.DataSource = dt

    End Sub

    ' No evento RowLeave guarda o ID e índice da coluna
    Private Sub DataGridView1_RowLeave(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.RowLeave

        If e.RowIndex <> -1 And Not _
                               Me.DataGridView1.Rows(e.RowIndex).IsNewRow Then
            currentRowID = Me.DataGridView1(0, e.RowIndex).Value
            currentCellIndex = e.ColumnIndex
        End If

    End Sub

   

    ' Após a ordenação verifica a posição anterior e selecciona-a
    Private Sub DataGridView1_Sorted(ByVal sender As Object, ByVal e As System.EventArgs) Handles DataGridView1.Sorted

        Dim index As Integer = getDGindex(currentRowID)

        Me.DataGridView1.CurrentCell = _
                              Me.DataGridView1.Rows(index).Cells(currentCellIndex)

    End Sub

PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!


Excel: Utilização de Shapes

09 agosto 2008 Tags: , 0 comentários

O Excel tem um grande número de shapes disponíveis que permitem melhorar graficamente as folhas de cálculo. São muito úteis e muito utilizadas, permitindo colocar comentários, chamadas de atenção, setas, estrelas, etc.

   

São tantas vezes utilizadas que por vezes a automatização do processo é útil e importante. Por exemplo, fazer aparecer ou criar uma shape quando a célula tem um determinado valor.




Para mostrar como se pode, através do VBA, automatizar processos utilizando shapes, será criado um exemplo onde serão adicionadas/removidas dinamicamente numa folha de cálculo de acordo com determinados critérios. Neste caso, existe uma lista de produtos em que é feita uma comparação entre dois anos (2006 e 2007) e será colocada um seta a indicar se existiu uma subida ou descida de vendas.

   

Para implementarmos este exemplo devemos fazer o seguinte:

   

1 – Menu Tools – Macros – Visual Basic Editor ou ALT+F11 na folha de calculo

2 – No Editor, mais precisamente na janela de projecto, seleccionamos a nossa worksheet (Sheet1 por exemplo)
3 – Colocamos o seguinte código no editor de código:

   

   

    ' Definição do tipo de seta

    Enum ArrowType

        UpArrow

        DownArrow

    End Enum

   

    ' ------------------------------------------------------------------

    ' Criar uma nova shape na célula indicada

    ' ------------------------------------------------------------------

    Private Sub CreateShape(ByVal Cell As Range, ByVal Arrow As ArrowType)

        Dim arrowWidth As Double, arrowHeight As Double

        Dim arrowTop As Double, arrowLeft As Double

        Dim sh As Shape

   

        ' Definições do tamanho e localização da seta de modo

        ' a ficar centrada na célula e com um comprimento

        ' comprimento de - 20% (para não ocupar na totalidade)

        arrowWidth = 15

        arrowHeight = Cell.Height - (Cell.Height * 0.2)

        arrowTop = Cell.Top + ((Cell.Height * 0.2) / 2)

        arrowLeft = (Cell.Left + (Cell.Width / 2)) - (arrowWidth / 2)

   

        ' Verifica qual o tipo de célula pretendido

        If Arrow = UpArrow Then

   

            ' Adiciona a shape na posição calculada

            sh = ActiveSheet.Shapes.AddShape(msoShapeUpArrow, arrowLeft, _

                     arrowTop, arrowWidth, arrowHeight)

   

            ' Define a cor do interior e linha(verde)

            With sh

                .Fill.ForeColor.RGB = vbGreen

                .Line.ForeColor.RGB = vbGreen

            End With

   

        Else

   

            ' Adiciona a shape na posição calculada

            sh = ActiveSheet.Shapes.AddShape(msoShapeDownArrow, arrowLeft, _

                    arrowTop, arrowWidth, arrowHeight)

   

            ' Define a cor do interior e linha(vermelho)

            With sh

                .Fill.ForeColor.RGB = vbRed

                .Line.ForeColor.RGB = vbRed

            End With

        End If

   

    End Sub

   

   

    ' ------------------------------------------------------------------

    ' Apaga a shape na célula indicada

    ' ------------------------------------------------------------------

    Private Sub DeleteShape(ByVal Cell As Range)

        Dim sh As Shape

   

        ' Faz um ciclo em todas as shapes na folha

        For Each sh In ActiveSheet.Shapes

   

            ' Caso a sua localização esteja na indicada, apaga-a

            If Not (Intersect(sh.TopLeftCell, Cell) Is Nothing) Then

                sh.Delete()

            End If

   

        Next

   

    End Sub

   

   

4 – Finalmente no evento Worksheet Change colocamos o seguinte código que irá verificar qual o valor alterado e indicará que tipo de shape criar:

   

   

    Private Sub Worksheet_Change(ByVal Target As Range)

   

        ' Verifica se existe uma alteração no range B2:C10

        If Not Intersect(Target, [B2:C10]) Is Nothing Then

   

            Dim val1 As Integer

            Dim val2 As Integer

   

            ' Verifica os valores referentes ao ano (2006/207)

            val1 = Cells(Target.Row, 2).Value

            val2 = Cells(Target.Row, 3).Value

   

            ' Caso o valor de 2006 seja superior

            If val1 > val2 Then

   

                ' Apaga a shape (caso exista) e cria uma nova

                Call DeleteShape(Cells(Target.Row, 4))

                Call CreateShape(Cells(Target.Row, 4), DownArrow)

   

             ' Caso o valor de 2006 seja inferior

            ElseIf val1 < val2 Then

   

                ' Apaga a shape (caso exista) e cria uma nova

                Call DeleteShape(Cells(Target.Row, 4))

                Call CreateShape(Cells(Target.Row, 4), UpArrow)

   

             ' Caso o valor seja igual, apaga a shape

            Else

                Call DeleteShape(Cells(Target.Row, 4))

            End If

   

        End If

   

    End Sub

   

   

   

Este exemplo poderia ser conseguido muito mais facilmente, utilizando apenas uma formula, recorrendo a um determinada fonte, como é o caso do Wingdings, e à formatação condicional. No entanto este exemplo pretende, acima de tudo, mostrar como manipular shapes dinamicamente e como este processo pode ajudar na automatização da nossa folha de cálculo.

   

   

PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!


Subscrever: Mensagens (Atom)


Microsoft Office Especialist

Membro da Comunidade
Experts-Exchange


Administ. da Comunidade
Portugal-a-Programar



Twitter

Artigos no CodeProject

Artigos no CodeProject

Subscrever Novidades

Endereço de Email:

Delivered by FeedBurner

Seguidores

Histórico