[VB.NET] Alternativa a SplashScreen

Descrizione :
Un'alternativa valida alle SplashScreen.

+ Articolo :

Dal momento che non vado matto per la SplashScreen di VS, riporto qui una mia soluzione alternativa.
La Form principale di avvio dell'Applicazione è FormMain, e tale deve rimanere, mentre FormSplash è la Form di Splash, che viene aperta, gestita e chiusa da FormMain.
Il presente esempio inoltre può essere utile anche come Form di attesa generico, da associare a qualsiasi Form principale.

FormMain deve semplicemente avere un paio di caratteristiche :
1. Un Timer "Timer1" con Interval = 1000 ( 1 secondo ).
2. Proprièta definita a design : Opacity = 0.

--> Codice per FormMain :

Public Class FormMain
 
    Private m_formsplash As FormSplash
    Private m_ticks As Integer
    Private m_splashticks As Integer = 3 'Secondi di permanenza splash
 
    Private Sub FormMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        m_formsplash = New FormSplash
        m_formsplash.Show()
        Timer1.Enabled = True
    End Sub
 
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        m_ticks += 1
        If m_ticks = m_splashticks Then
            Timer1.Enabled = False
            Me.Opacity = 1
            m_formsplash.Close()
        End If
    End Sub
 
End Class

La Classe FormSplash, è una semplice Form, con :
- FormBorderStyle = None
- StartPosition = CenterScreen.

Nessun bisogno di avere una "NotInheritable Class SplashScreen1", nè di impostarla a Form di avvio.
Se si desidera replicare le informazioni contenute di default nella SplashScreen, basta aggiungere 3 Labels in FormSplash con questo codice :

Public Class FormSplash

    Private Sub FormSplash_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        If My.Application.Info.Title <> "" Then
            Label1.Text = My.Application.Info.Title
        Else
            'Se il titolo dell'applicazione è mancante, verrà utilizzato il nome dell'applicazione, senza l'estensione
            Label1.Text = System.IO.Path.GetFileNameWithoutExtension(My.Application.Info.AssemblyName)
        End If
        Label2.Text = "Versione {0}.{1:00}"
        Label2.Text = System.String.Format(Label2.Text, My.Application.Info.Version.Major, My.Application.Info.Version.Minor)
        Label3.Text = My.Application.Info.Copyright
    End Sub

End Class

Tutto il resto ( immagine di sfondo, Labels con informazioni aggiuntive, aspetto grafico, e quant'altro ) lo si personalizza come si vuole, come si farebbe su una Form qualsiasi.

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB.NET] Copia di Files con ProgressBar

Descrizione :
Esempio di copia file-per-file di una directory, e relative sub-directories con avanzamento ProgressBar.

+ Articolo :

Il codice seguente esegue la copia di tutti i file ( *.* ) trovati in un determinato percorso e in tutte le sue diramazioni, mostrando l'avanzamento del processo in una ProgressBar standard "ProgressBar1". La copia di ogni file incrementa di 1 il progresso.
La copia ricrea anche la struttura originaria delle cartelle trovate nel percorso originario.

In questo caso, la cartella "\sourceDir\" verrà di fatto "rinominata" come "\targetDir\" :

        Dim sourceDir As String = "C:\sourceDir"
        Dim targetDir As String = "D:\targetDir"
        Dim files() As String = IO.Directory.GetFiles(sourceDir, "*.*", IO.SearchOption.AllDirectories)
 
        With ProgressBar1
            .Minimum = 0
            .Value = .Minimum
            .Maximum = files.Count
        End With
 
        Dim newDir As String
        Dim FI As IO.FileInfo
        For Each f As String In files
            FI = New IO.FileInfo(f)
            newDir = targetDir & "\" & FI.DirectoryName.Substring(sourceDir.Length) & "\"
            If Not IO.Directory.Exists(newDir) Then IO.Directory.CreateDirectory(newDir)
            IO.File.Copy(f, newDir & FI.Name, True)
            ProgressBar1.Value += 1
        Next
 
        MessageBox.Show("Copia completata.")

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB.NET] Informazioni su Programmi Installati

Descrizione :
Una tecnica valida per ricavare dal registro di sistema informazioni su programmi e aggiornamenti installati.

+ Articolo :

L'esempio utilizza una Function e una Structure. La Structure rappresenta la singola entità "Programma" presente nel sistema.
Inoltre è utile anche come esempio di caricamento diretto di oggetti non-string in una ComboBox, e successiva estrazione dell'oggetto selezionato dall'utente.

In questo caso vengono gestite 3 voci :

- DisplayName ( necessario )
- InstallDate
- UninstallString

1. Una ComboBox in VB.NET non può solo contenere stringhe, ma molto di più ( e qui dovrei bacchettarmi le mani da solo, perchè in .NET la Stringa è un oggetto... ). Ma era per rendere l'idea...

2. La Structure, Public in un Modulo :

    Public Structure programma
 
        Public DisplayName As String
        Public InstallDate As String
        Public UninstallString As String
 
        Public Overrides Function ToString() As String
            Return Me.DisplayName
        End Function
 
    End Structure

L'Override del Metodo ToString() assicura che, nel caso io vada a caricare direttamente un'istanza di questa Structure, ad esempio nella nostra ComboBox, la rappresentazione Stringa dell'Oggetto, di default sia, in questo caso, la Proprietà DisplayName.

3. La Function, Public in un Modulo, restituisce una List() di Structure :

   Public Function ProgrammiInstallati() As List(Of programma)
 
        Dim L As New List(Of programma)
        Dim regPath As String = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
        Dim regKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey(regPath)
        Dim regSubKeys() As String = regKey.GetSubKeyNames
        Dim regSubKey As Microsoft.Win32.RegistryKey
        Dim displayName As String
        Dim CI As New System.Globalization.CultureInfo("en-US")
        Dim installDate As String
        Dim uninstallString As String
        Dim P As programma
 
        For Each rsk As String In regSubKeys
 
            P = New programma
 
            regSubKey = regKey.OpenSubKey(rsk)
            displayName = regSubKey.GetValue("DisplayName", "N.D.")
 
            P.DisplayName = displayName
 
            installDate = regSubKey.GetValue("InstallDate")
            If installDate Is Nothing Then
                installDate = "N.D."
            Else
                Try
                    installDate = DateTime.ParseExact(installDate, "yyyyMMdd", CI).ToString("dd/MM/yyyy")
                Catch ex As Exception
                End Try
            End If
            P.InstallDate = installDate
 
            uninstallString = regSubKey.GetValue("UninstallString", "N.D.")
            P.UninstallString = uninstallString
 
            L.Add(P)
 
        Next
 
        Return L
 
    End Function

4. Carico la ComboBox :

        For Each P As programma In ProgrammiInstallati()
            ComboBox1.Items.Add(P)
        Next

5. Selezione su ComboBox :

    Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
 
        Dim installDate As String = DirectCast(ComboBox1.SelectedItem, programma).InstallDate
        Dim uninstallString As String = DirectCast(ComboBox1.SelectedItem, programma).UninstallString
        MessageBox.Show(installDate & " --- " & uninstallString)
 
    End Sub

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB.NET] Forms con Effetto Dissolvenza

Descrizione :
Tecnica per ottenere un effetto Fade-In / Fade-Out da associare all'apertura / chiusura Form.

+ Articolo :

Contrariamente a quanto alcuni pensano, la Proprietà Opacity non è di tipo intero e il suo valore non va da 0 a 100.
Nella pratica gli unici valori realmente utili vanno da 0 a 1.
Opacity è di tipo Double, e l'assegnazione di un qualsiasi valore Double al di fuori del range non produce errori.
Con Opacity = 0 si ha la totale trasparenza, mentre con Opacity = 1, la totale opacità.

Ogni tentativo di passare un valore al di fuori del Range [0>1] viene tollerato, ma l'effetto sarà ininfluente :

       Me.Opacity = 1.1
       MessageBox.Show(Me.Opacity)

       Me.Opacity = -0.1
       MessageBox.Show(Me.Opacity)

--> Form1 :

1. Contiene un Timer "tmr_fading". L'Interval deve essere molto contenuto, ad esempio 10 o 20 msec.

2. La Form interessata deve avere a design la proprietà Opacity già impostata a 0%.

--> Codice :

Public Class Form1

    Private m_op As Double = 0
    Private m_close As Boolean = False
    Private m_fadeinout As Boolean ' IN=True / OUT=False

    Private Sub LoadFadeIn()
        m_fadeinout = True
        tmr_fading.Enabled = True
    End Sub

    Private Sub CloseFadeOut()
        m_fadeinout = False
        tmr_fading.Enabled = True
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        LoadFadeIn()
    End Sub

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        e.Cancel = Not m_close
        CloseFadeOut()
    End Sub

    Private Sub tmr_fading_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmr_fading.Tick
        If m_fadeinout = True Then
            m_op += 1
        Else
            m_op -= 1
        End If
        Me.Opacity = m_op / 100
        If m_op >= 100 Then DirectCast(sender, Timer).Enabled = False
        If m_op <= 0 Then
            m_close = True
            Me.Close()
        End If
    End Sub

End Class

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB.NET] Filtro BindingSource per Word Search

Descrizione :
Un metodo per costruire un filtro di ricerca da passare ad un BindingSource, allo scopo di filtrare frasi di testo di qualsiasi dimensione in base ad un numero variabile di parole chiave.

+ Articolo :

Per "parola" si intende una particolare substring del testo, che deve essere presa singolarmente, e ignorata se invece è solo parte di un'altra parola, che la contiene.
Nello snippet che segue si parte da un array di parole da ricercare nel testo. Tutte le parole in array verranno poste in AND tra di loro, e il BindingSource restituirà solo le frasi corripondenti al Campo associato ( nomeCampo, in questo esempio "testo" ) che contengono almeno una volta tutte le parole chiave.

Le parole da ricercare vanno messe in AND.
Per ogni parola chiave in array occorrono 3 LIKE, da mettere in OR tra loro :

--> testo LIKE 'parola %' ( se la parola è la prima di testo )
--> testo LIKE '% parola %' ( se la parola è in una qualsiasi posizione intermedia nel testo )
--> testo LIKE '% parola' ( se la parola è l'ultima di testo )

Il codice :

        Dim nomeCampo As String = "testo"
        Dim sbFilter As New System.Text.StringBuilder

        'Più parole da mettere in AND
        Dim paroleFiltro() As String = {"parola1", "parola2", "parola3"}
        Dim parolaFiltro As String

        'Costruzione filtro
        For i As Integer = 0 To paroleFiltro.Length - 1

            'Caratteri Escape
            parolaFiltro = paroleFiltro(i)
            parolaFiltro = parolaFiltro.Replace("'", "''").Replace("%", "[%]").Replace("*", "[*]")
            sbFilter.Append("(" & nomeCampo & " LIKE '" & parolaFiltro & " %'" & _
                            " OR " & nomeCampo & " LIKE '% " & parolaFiltro & " %'" & _
                            " OR " & nomeCampo & " LIKE '% " & parolaFiltro & "')")
            If i < paroleFiltro.Length - 1 Then sbFilter.Append(" AND ")

        Next

        BS.Filter = sbFilter.ToString

Dove BS è il BindingSource collegato all'origine dati che contiene il Campo "testo".
Per ogni parola in array il codice provvede all'aggiunta dei caratteri di escape necessari ad evitare errori con eventuali parole chiave che contengano %, ', *.

Funziona con un qualsiasi numero di parole da ricercare, da 1 a N, e quale che sia il numero e la posizione nel testo in cui tali parole vengono eventualmente trovate.

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB.NET] Estrazione linee da TextBox MultiLine

Descrizione :
Questa mia Function restituisce una List(Of String) delle linee contenute in una TextBox.

+ Articolo :

La Function in questione estrae le linee di testo da un controllo TextBox, indipendentemente dalle proprietà impostate, che abbia WordWrap a True o False, che l'utente abbia fatto o meno uso del "Return" per andare a capo, o che abbia lasciato linee vuote o incomplete.

Inoltre da ogni linea presente nella List() restituita vengono rimossi gli eventuali caratteri ControlChars.NewLine, che in una logica di testo linea-per-linea, avrebbero poco senso.

    Public Function GetTextBoxLines(ByVal TB As TextBox) As List(Of String)

        Dim lines As New List(Of String)
        If TB.TextLength = 0 Then Return lines

        Dim iStartLine As Integer = 0 'Indice Char di inizio linea
        Dim iEndLine As Integer = 0 'Indice Char di fine linea
        Dim iLine As Integer = 0 'Indice di linea ( numero linee incognito )
        Do
            iStartLine = TB.GetFirstCharIndexFromLine(iLine)
            iEndLine = TB.GetFirstCharIndexFromLine(iLine + 1)
            If iEndLine > -1 Then
                lines.Add(TB.Text.Substring(iStartLine, iEndLine - iStartLine))
            Else
                lines.Add(TB.Text.Substring(iStartLine, TB.TextLength - iStartLine))
                Exit Do
            End If
            iLine += 1
        Loop

        'Eliminazione Chars NewLine
        For i As Integer = 0 To lines.Count - 1
            lines(i) = lines(i).Replace(ControlChars.NewLine, "")
        Next

        Return lines

    End Function

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB.NET] Gestione ricorsiva voci MenuStrip

Descrizione :
Una tecnica per gestire gli Handlers di menu particolarmente complessi.

+ Articolo :

Non è necessario scrivere un Evento Click separato per ogni Item o SubItem di un MenuStrip.
Nel caso in cui si abbiano menu con molte diramazioni e/o menu dinamici, può essere utile gestirne gli Handlers via codice.

Si può gestire l'evento Click solo su tutti gli Items e SubItems del menu che NON hanno ulteriori diramazioni, ma che costituiscono le voci di menu effettive ( che quindi corrispondono alle azioni vere e proprie dell'applicazione ).
Tutto può essere fatto in modo centralizzato, con un Metodo ricorsivo che aggiunge gli Handlers solo alle voci di menu "finali".

1. Il Metodo ricorsivo :

    Private Sub CreaHandlersMenu(ByVal tsmi As ToolStripMenuItem)
 
        If tsmi.HasDropDownItems Then
            For Each ddi As ToolStripDropDownItem In tsmi.DropDownItems
                If ddi.HasDropDownItems Then
                    CreaHandlersMenu(ddi)
                Else
                    AddHandler ddi.Click, New EventHandler(AddressOf MioMenuItemClick)
                End If
            Next
        Else
            AddHandler tsmi.Click, New EventHandler(AddressOf MioMenuItemClick)
        End If
 
    End Sub

2. Il Metodo associato al Click :

    Private Sub MioMenuItemClick(ByVal sender As System.Object, ByVal e As System.EventArgs)
        MessageBox.Show(DirectCast(sender, ToolStripMenuItem).Text)
    End Sub

Da modificare a piacere.

3. Codice di aggiunta Handlers, tipicamente su Form Load :

    For Each tsmi As ToolStripMenuItem In MenuStrip1.Items
        CreaHandlersMenu(tsmi)
    Next

Quale che sia il numero e il livello dei menu e sottomenu nidificati, risolve.

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB.NET] Gestire scambi di Focus tra controlli

Descrizione :
Un esempio su come gestire in modo centralizzato il passaggio di Focus tra due controlli.

+ Articolo :

A volte può essere utile tenere traccia del passaggio di Focus tra un dato controllo e quello la cui modifica è logicamente correlata al precedente.

In questo esempio veniva chiesto come :

1. Visualizzare un messaggio warning solo se il Focus fosse passato da una delle 2 TextBox interessate all'altra.
2. Se il Focus fosse passato da una delle TextBox ad un Button > nessun warning.
3. Se il Focus fosse passato da un Button ad una delle TextBox > nessun warning.

Una possibilità è quella di raggruppare in un unico Metodo il check su quale controllo ha appena subito il Leave e quale ha appena ricevuto il Focus.

Se si interroga il Me.ActiveControl della Form durante un evento Leave si scopre che di fatto lo stato attivo è già sul secondo controllo, anche se l'aggiornamento della UI avviene dopo.

Se ad esempio ho una Form che ha 2 TextBox e 1 Button :

    Private Sub TextBox1_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.Leave
        ctrlLeaveGotFocus(sender)
    End Sub
 
    Private Sub TextBox2_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox2.Leave
        ctrlLeaveGotFocus(sender)
    End Sub

Entrambi chiamano un Metodo che si può costruire secondo esigenza, e che nel mio caso è :

    Private Sub ctrlLeaveGotFocus(ByVal ctrlL As Control)
 
        Dim strLost As String
        Dim strGot As String
        If TypeOf ctrlL Is TextBox And TypeOf Me.ActiveControl Is TextBox Then
            strLost = DirectCast(ctrlL, TextBox).Name
            strGot = DirectCast(Me.ActiveControl, TextBox).Name
            MessageBox.Show(strLost & " ha perso il Focus." & Environment.NewLine & strGot & " ha ora il Focus.")
        End If
 
    End Sub

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB6] Arrotondamenti Diversificati con Select Case

Descrizione :
Un esempio su come usare una Select Case per eseguire un arrotondamento personalizzato di numeri in base a range prestabiliti.

+ Articolo :

Si sfrutta la possiblità di usare Case x To y : il che comporta l'esclusione dell'estremo sinistro (x) del range, e l'inclusione del destro (y).
In sostanza Case x To y equivale a : Valore > x AND <= y.

Nell'esempio di codice seguente si desidera arrotondare il numero in input secondo questi range :

Da 0 a 10 deve essere arrotondato al 0,10
Da 10,01 a 20 deve essere arrotondato al 1,00
Da 20,01 a 30 deve essere arrotondato al 2,00
Da 30,01 a 100 deve essere arrotondato al 3,00
Da 100,01 a 1000 deve essere arrotondato al 5,00
Da 1000,01 a 2000 deve essere arrotondato al 10,00
Da 2000,00 a 3000 deve essere arrotondato al 20,00
Da 3000,01 a 5000 deve essere arrotondato al 30,00
...

--> Codice Esempio :

    Dim valore As Double
    valore = 33.0005
 
    Dim valoreRound As Double
 
    Select Case valore
 
        Case 0 To 10
            valoreRound = Round(valore, 1)
            If valoreRound < valore Then valoreRound = valoreRound + 0.1
 
        Case 10 To 20
            valoreRound = Round(valore, 0)
            If valoreRound < valore Then valoreRound = valoreRound + 1
 
        Case 20 To 30
            valoreRound = Int(valore / 2) * 2 + 2
 
        Case 30 To 100
            valoreRound = Int(valore / 3) * 3 + 3
 
        '...
        '...
        '...
 
    End Select
 
    MsgBox valoreRound

Questi i primi 4 casi. Per i successivi non fate altro che ripetere il Caso 4 sostituendo con i valori desiderati...

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB6

[VB.NET] Gestione Cross Threading ...

Descrizione :
Un esempio su come gestire l'accesso a controlli Forms da threads esterni, scongiurando l'errore di Cross-Thread.

+ Articolo :

Nell'esempio ho una Form ( Form1 ) con un Button "cmd_startthread", e una ListBox "ListBox1", e la Classe "MyThreadClass", che deve aggiungere N Items a ListBox1 da un altro Thread.

Come si può notare da : Delegate Sub AddListItem(ByVal arg As String),
c'è anche un'indicazione molto utile su come gestire Delegates che accettano parametri,
perciò l'esempio è semplice, ma non banale...

1. Codice MyThreadClass :

Public Class MyThreadClass
 
    Private m_form As Form1
 
    Public Sub New(ByVal F As Form1)
        m_form = F
    End Sub
 
    Public Sub Run()
        For i As Integer = 1 To 10
            m_form.Invoke(m_form.myDelegate, New Object() {"Item " & i.ToString})
            Threading.Thread.Sleep(500)
        Next
    End Sub
 
End Class 

2. Codice Form1 :

Public Class Form1
 
    Private myThread As System.Threading.Thread
 
    Delegate Sub AddListItem(ByVal arg As String)
    Public myDelegate As New AddListItem(AddressOf AddListItemMethod)
 
    Private Sub AddListItemMethod(ByVal arg As String)
        ListBox1.Items.Add(arg)
    End Sub
 
    Private Sub ThreadMethod()
        Dim myThreadClassObject As New MyThreadClass(Me)
        myThreadClassObject.Run()
    End Sub
 
    Private Sub cmd_startthread_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd_startthread.Click
        myThread = New System.Threading.Thread(AddressOf ThreadMethod)
        myThread.Start()
    End Sub
 
End Class

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[VB6] Interazione con Excel

Descrizione :
Un esempio semplice di lettura e scrittura di files Excel da VB6.

+ Articolo :

Scopo principale di questo articolo è di mettere in chiaro alcuni aspetti importanti ( almeno per me lo sono ) della gestione di documenti Office - in questo caso files di Excel 2007.

1. Si può ottenere un sensibile miglioramento sulla velocità delle operazioni impostando a False la visibilità dell'Application Excel.

2. Ottima cosa è creare un Oggetto per ogni WorkBook da gestire.

3. Le operazioni di Selezione - i vari .Select, e conseguenti richiami ad ActiveSheet, ActiveCell, e quant'altro, al 99% NON sono affatto necessari nelle operazioni di lettura o scrittura, e vanno evitate. Non solo perchè espongono a risultati spesso indesiderati, ma anche perchè rallentano il processo.

4. Una volta che ogni enità Excel è rappresentata dal proprio Oggetto, ci si riferisce sempre a quello, per ogni operazione.
Al termine del processo si chiudono e si scaricano sempre tutti gli Oggetti.

--> Nell'esempio ho due File Excel 2007 : ADD_1.xlsx e ADD_2.xlsx su cui eseguo operazioni di lettura cella per cella.
Un terzo file : SUM.xlsx destinato a contenere la somma delle celle da A1 ad A10 dei primi due.

--> N.B.: nel caso di Excel 2007 occorre aggiungere al Progetto un
RIF. a Microsoft Excel 12.0 Object Library.

--> Codice Esempio :

    'Esempio con Excel 2007 :
    'RIF. a Microsoft Excel 12.0 Object Library

    'Percorso relativo WorkBooks
    Dim percorso As String
    percorso = App.Path & "\"
    
    'Applicazione Excel : UNA sola per tutti i WorkBooks
    'coinvolti nell'operazione
    Dim AppExcel As Excel.Application
    Set AppExcel = New Excel.Application
    'Visibilità Applicazione Excel
    AppExcel.Visible = False
    
    'Oggetti WorkBooks
    Dim WBAdd1 As Excel.Workbook
    Set WBAdd1 = AppExcel.Workbooks.Open(percorso & "ADD_1.xlsx")
    Dim WBAdd2 As Excel.Workbook
    Set WBAdd2 = AppExcel.Workbooks.Open(percorso & "ADD_2.xlsx")
    Dim WBSum As Excel.Workbook
    Set WBSum = AppExcel.Workbooks.Open(percorso & "SUM.xlsx")
    
    'Operazioni
    Dim addendo1 As Integer
    Dim addendo2 As Integer
    Dim somma As Integer
    
    Dim i As Long
    For i = 1 To 10
        
        addendo1 = WBAdd1.Worksheets("Foglio1").Range("A" & i).Value
        addendo2 = WBAdd2.Worksheets("Foglio1").Range("A" & i).Value
        
        somma = addendo1 + addendo2
        WBSum.Worksheets("Foglio1").Range("A" & i).Value = somma
        
    Next i
 
    'Salvataggio / Chiusura Oggetti
    WBAdd1.Close SaveChanges:=False
    Set WBAdd1 = Nothing
    WBAdd2.Close SaveChanges:=False
    Set WBAdd2 = Nothing
    WBSum.Close SaveChanges:=True
    Set WBSum = Nothing
    
    'Chiusura Applicazione Excel
    AppExcel.Quit
    Set AppExcel = Nothing
    
    MsgBox "Processo completato", vbInformation, "OK"

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB6

[VB.NET] Simulare uno Zoom su Image

Descrizione :
Semplice Function per "simulare" uno Zoom su Image.

+ Articolo :

Si tratta di uno dei sistemi più semplici per simulare con discreta qualità uno Zoom su Oggetto Image.
Il parametro fattoreZoom deve essere un numero intero positivo.
Il fattore di Zoom interno "z", serve ad andare a passi di zoom più ravvicinati ( nel presente caso avremo zoom : 1, 1.2, 1.4, 1.6, ..., ecc. ).

    Public Function Zoom(ByVal imgInput As Image, ByVal fattoreZoom As Integer) As Image
 
        Dim z As Single = 0.2
        Dim fZoom As Single
        If fattoreZoom <= 1 Then
            fZoom = 1
        Else
            fZoom = z * (fattoreZoom - 1) + 1
        End If
        Dim bmp As New Bitmap(imgInput, Convert.ToInt32(imgInput.Width * fZoom), Convert.ToInt32(imgInput.Height * fZoom))
        Return bmp
 
    End Function

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[Excel VBA] CopyFromRecordset

Descrizione :
Semplice tecnica VBA per importare velocemente dati da un DB Access in un Foglio Excel.

+ Articolo :

Il Metodo CopyFromRecordset è disponiblie a partire da Excel 2003.

Di seguito mostro 3 varianti per file Access .mdb : le prime due usano CopyFromRecordset, mentre l'ultima un Loop diretto sul Recordset ottenuto.

N.B.: E' necessario aggiungere nell'Editor VBA ( menu Strumenti / Riferimenti ), se già non presente nel Progetto VBA corrente, un Riferimento alla libreria :
Microsoft DAO 3.6 Object Library
Nel caso di questo esempio ( Excel + Access 2003 ), la versione è la 3.6.

Nell'esempio il DB Access è nella stessa cartella del file Excel.

--> Variante 1 :
E' il sistema più immediato. Il Recordset viene caricato direttamente da una Tabella o Stored Query di Access :

    Dim percorso As String 'Percorso File DB
    percorso = ThisWorkbook.Path & "\"
 
    Dim nomeDb As String 'Nome File DB
    nomeDb = "nomeDB.mdb"
 
    Dim nomeTabQry As String 'Nome Tabella o Stored Query Access
    nomeTabQry = "nomeTabella"
 
    Dim DB As Database
    Dim RS As Recordset
    Set DB = OpenDatabase(percorso & nomeDb)
    Set RS = DB.OpenRecordset(nomeTabQry)
 
    'Intestazione Colonne
    Dim i As Integer
    For i = 0 To RS.Fields.Count - 1
        ThisWorkbook.Worksheets("Foglio1").Cells(1, i + 1).FormulaR1C1 = RS.Fields(i).Name
    Next i
 
    'Tabella Dati
    ThisWorkbook.Worksheets("Foglio1").Range("A2").CopyFromRecordset RS
 
    Set RS = Nothing
    DB.Close
    Set DB = Nothing

--> Variante 2 :
Il Recordset viene caricato con una Query definita come stringa in Excel :

    Dim percorso As String 'Percorso File DB
    percorso = ThisWorkbook.Path & "\"
 
    Dim nomeDb As String 'Nome File DB
    nomeDb = "nomeDB.mdb"
 
    Dim strSql As String 'Stringa Sql
    strSql = "SELECT * FROM nomeTabella"
 
    Dim DB As Database
    Dim RS As Recordset
    Set DB = OpenDatabase(percorso & nomeDb)
    Set RS = DB.OpenRecordset(strSql)
 
    'Intestazione Colonne
    Dim i As Integer
    For i = 0 To RS.Fields.Count - 1
        ThisWorkbook.Worksheets("Foglio1").Cells(1, i + 1).FormulaR1C1 = RS.Fields(i).Name
    Next i
 
    'Tabella Dati
    ThisWorkbook.Worksheets("Foglio1").Range("A2").CopyFromRecordset RS
 
    Set RS = Nothing
    DB.Close
    Set DB = Nothing

--> Variante 3 :
Voglio copiare le righe del Recordset intervallandole con righe vuote ( un esempio su come avere maggior controllo sul RS ottenuto ).
Non uso più CopyFromRecordset, ma un Loop :

    Dim percorso As String 'Percorso File DB
    percorso = ThisWorkbook.Path & "\"
 
    Dim nomeDb As String 'Nome File DB
    nomeDb = "nomeDB.mdb"
 
    Dim nomeTabQry As String 'Nome Tabella o Stored Query Access
    nomeTabQry = "nomeTabella"
 
    Dim DB As Database
    Dim RS As Recordset
    Set DB = OpenDatabase(percorso & nomeDb)
    Set RS = DB.OpenRecordset(nomeTabQry)
 
    'Intestazione Colonne
    Dim i As Integer
    For i = 0 To RS.Fields.Count - 1
        ThisWorkbook.Worksheets("Foglio1").Cells(1, i + 1).FormulaR1C1 = RS.Fields(i).Name
    Next i
 
    'Tabella Dati
    Dim r As Long
    r = 3
    If Not RS.BOF Then RS.MoveFirst
    While Not RS.EOF
        For i = 0 To RS.Fields.Count - 1
            ThisWorkbook.Worksheets("Foglio1").Cells(r, i + 1).FormulaR1C1 = RS.Fields(i).Value
        Next i
        RS.MoveNext
        r = r + 2
    Wend
 
    Set RS = Nothing
    DB.Close
    Set DB = Nothing

In presenza di file di database .accdb, meglio affidarsi ad ADODB ( che può essere valida alternativa anche per i casi precedenti ), quindi in questo caso andrà aggiunto un RIF. alla Libreria :
Microsoft ActiveX Data Objects 2.8 Library

--> Variante 1 ( con Access 2007 ) :

    Dim percorso As String 'Percorso File DB
    percorso = ThisWorkbook.Path & "\"
 
    Dim nomeDb As String 'Nome File DB
    nomeDb = "nomeDB.accdb"
 
    Dim nomeTabQry As String 'Nome Tabella o Stored Query Access
    nomeTabQry = "nomeTabella"
 
    Dim CN As ADODB.Connection
    Dim RS As ADODB.Recordset
    Set CN = New ADODB.Connection
    CN.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                           percorso & nomeDb & ";Persist Security Info=False;"
    CN.Open
    Set RS = New ADODB.Recordset
    RS.Open nomeTabQry, CN, adOpenKeyset, adLockReadOnly, adCmdTable
 
    'Intestazione Colonne
    Dim i As Integer
    For i = 0 To RS.Fields.Count - 1
        ThisWorkbook.Worksheets("Foglio1").Cells(1, i + 1).FormulaR1C1 = RS.Fields(i).Name
    Next i
 
    'Tabella Dati
    ThisWorkbook.Worksheets("Foglio1").Range("A2").CopyFromRecordset RS
 
    CN.Close
    Set CN = Nothing
    Set RS = Nothing

Varianti 2 e 3 per .accdb, analogamente ai casi visti per file .mdb.

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: Excel VBA

[VB6] Combinazioni Semplici e con Ripetizione

Descrizione :
Due Function di mia "invenzione" per il calcolo delle Combinazioni con e senza Ripetizione.

+ Articolo :

1. Combinazioni semplici ( senza ripetizioni ) :
Si chiama combinazione semplice una presentazione di elementi di un insieme nella quale non ha importanza l'ordine dei componenti e non si può ripetere lo stesso elemento più volte.

arrayElementi è l'Array degli N elementi dell'insieme S di partenza.
Faccio notare che tale Array è di tipo Variant, e che la mia Function può operare su Array di svariati tipi, quindi Integer, String, Char, ecc...
dimensioneGruppo indica il numero di elementi da prendere in ogni Combinazione generata.

--> La Function :

Public Function CombinazioniSemplici(ByVal arrayElementi As Variant, ByVal dimensioneGruppo As Byte) As Collection
 
    Dim LC As New Collection
    If UBound(arrayElementi) = 0 Then
        Set CombinazioniSemplici = LC
    End If
    If dimensioneGruppo = 0 Or dimensioneGruppo > UBound(arrayElementi) Then
        Set CombinazioniSemplici = LC
    End If
    Dim aP() As Integer
    ReDim aP(dimensioneGruppo - 1)
    Dim i As Integer
    For i = 0 To UBound(aP)
        aP(i) = i
    Next i
    Dim j As Integer
    Dim C As String
    Dim cnt As Integer
    Do
        C = ""
        For i = 0 To UBound(aP)
            C = C & arrayElementi(aP(i))
        Next i
        LC.Add (C)
 
        cnt = 0
        For i = UBound(aP) To 0 Step -1
            If aP(i) = UBound(arrayElementi) - cnt Then
                cnt = cnt + 1
                If cnt = UBound(aP) + 1 Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP)
                    If i < j Then aP(j) = aP(i) + (j - i)
                Next
                Exit For
            End If
        Next i
    Loop
 
    Set CombinazioniSemplici = LC
 
End Function

--> Un Esempio di Utilizzo ( Output su ListBox ) :

    List1.Clear
 
    Dim N() As Variant
    N = Array("a", "b", "c", "d")
    Dim K As Byte
    K = 3
 
    Dim Comb As Collection
    Set Comb = CombinazioniSemplici(N, K)
 
    Dim i As Integer
    For i = 1 To Comb.Count
        List1.AddItem (Comb(i))
    Next i
 
    MsgBox "Numero combinazioni generate = " & Comb.Count

2. Combinazioni con Ripetizione :
Quando l'ordine non è importante ma è possibile avere componenti ripetute si parla di combinazioni con ripetizione. Il numero di combinazioni con ripetizione di N oggetti di classe K è uguale a quello delle combinazioni senza ripetizione di N + K - 1 oggetti di classe K.

arrayElementi è l'Array degli N elementi dell'insieme S di partenza.
Anche qui l'Array è di tipo Variant, e la mia Function può operare su Array di svariati tipi, quindi Integer, String, Char, ecc...
classe indica il numero di elementi da prendere in ogni Combinazione generata.

--> La Function :

Public Function CombinazioniConRipetizione(ByVal arrayElementi As Variant, ByVal classe As Byte) As Collection
 
    Dim LC As New Collection
    If UBound(arrayElementi) = 0 Then
        Set CombinazioniConRipetizione = LC
    End If
    If classe = 0 Then
        Set CombinazioniConRipetizione = LC
    End If
    Dim aP() As Integer
    ReDim aP(classe - 1)
    Dim i As Integer
    Dim j As Integer
    Dim C As String
    Dim cnt As Integer
    Do
        C = ""
        For i = 0 To UBound(aP)
            C = C & arrayElementi(aP(i))
        Next i
        LC.Add (C)
 
        cnt = 0
        For i = UBound(aP) To 0 Step -1
            If aP(i) = UBound(arrayElementi) Then
                cnt = cnt + 1
                If cnt = UBound(aP) + 1 Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP)
                    If i < j Then aP(j) = aP(i)
                Next
                Exit For
            End If
        Next i
    Loop
 
    Set CombinazioniConRipetizione = LC
 
End Function 

--> Un Esempio di Utilizzo ( Output su ListBox ) :

    List1.Clear
 
    Dim N() As Variant
    N = Array("a", "b", "c", "d")
    Dim K As Byte
    K = 3
 
    Dim Comb As Collection
    Set Comb = CombinazioniConRipetizione(N, K)
 
    Dim i As Integer
    For i = 1 To Comb.Count
        List1.AddItem (Comb(i))
    Next i
 
    MsgBox "Numero combinazioni generate = " & Comb.Count

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB6

[Excel VBA] Importazione WorkSheets da files esterni

Descrizione :
Una tecnica per automatizzare l'importazione su singolo file Excel di fogli da files esterni e da varie cartelle.

+ Articolo :

E' necessario predisporre un WorkBook di "comando", che esegue il codice necessario per la creazione di un nuovo WorkBook di "destinazione", che conterrà, alla fine del processo, N Fogli presi da N Files esterni che si trovano in percorsi forniti come array di percorsi alla routine del comando stesso.
Per semplicità, nell'esempio seguente viene mostrato come importare il primo Foglio di ciascuno dei files Excel trovati, in ciascuna delle directory inserite nell'array.

Il File "Comando.xls" ha un solo Foglio "Foglio1" con un CommandButton.

All'esecuzione il File Comando copia in se stesso tutti i Fogli di un certo indice ( nel nostro caso il Foglio a indice 1 ) trovati nei Files contenuti in tutti i percorsi di ricerca forniti. Alla fine del processo il file Comando salva se stesso con un nome predefinito per il File di Output ed elimina il Foglio che contiene la routine di creazione.
In questo modo evito di gestire la creazione di un terzo file e l'inserimento dei Fogli sullo stesso, che aggiungerebbe all'operazione una serie di passaggi inutili, inoltre il salvataggio permette di chiudere automaticamente il file Comando senza rischi di sovrascrittura...

N.B.: Aggiungere un Rif. alla libreria "Microsoft Scripting Runtime".

--> Codice per il pulsante su Comando.xls :

    'Aggiungere RIF.: Microsoft Scripting Runtime
 
    Dim FSO As New Scripting.FileSystemObject
 
    Dim percorsi() As Variant
    percorsi = Array(ThisWorkbook.Path & "\Cartella1\", ThisWorkbook.Path & "\Cartella2\")
    Dim percorsoDest As String
    percorsoDest = ThisWorkbook.Path & "\"
 
    Dim nomeFileDest As String
    nomeFileDest = "Destinazione.xls"
    If FSO.FileExists(percorsoDest & nomeFileDest) = True Then
        FSO.DeleteFile percorsoDest & nomeFileDest
    End If
 
    Dim fd As Folder
    Dim f As File
    Dim nomeFile As String
    Dim nomeFoglio As String
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim cnt As Integer
    cnt = 1
 
    Application.ScreenUpdating = False
    'Application.Visible = False
 
    For Each percorso In percorsi
        Set fd = FSO.GetFolder(percorso)
        For Each f In fd.Files
            'Controllo sulle estensioni dei file da importare...
            If FSO.GetExtensionName(f.Path) = "xls" Then ' OR < altre estensioni Excel >...
                nomeFile = f.Name
                nomeFoglio = cnt & "_" & Left(nomeFile, Len(nomeFile) - Len(FSO.GetExtensionName(f.Path)) - 1)
 
                Set WB = Application.Workbooks.Open(percorso & nomeFile)
                Set WS = WB.Worksheets(1)
                WS.Name = nomeFoglio
                WS.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
 
                WB.Close False
                Set WB = Nothing
                cnt = cnt + 1
            End If
        Next f
    Next percorso
 
    Application.ScreenUpdating = True
    'Application.Visible = True
 
    ThisWorkbook.SaveAs percorsoDest & nomeFileDest
    MsgBox "Fogli Importati.", vbInformation, "OK"
 
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(1).Delete

Alcune note :

1. Come spesso accade, gran parte dell'apparente laboriosità nell'esecuzione di un codice VBA dipende principalmente da questioni di refresh grafico. Allo scopo di rendere più snello il processo è presente una riga con Application.ScreenUpdating = False.
Ho volutamente lasciato anche Application.Visible = False, commentato, da usarsi in alternativa al primo, con l'effetto di rendere l'esecuzione ancora più veloce.
Unico inconveniente è che su importazioni lunghe l'utente vedrebbe sparire la finestra di Excel per un certo tempo e potrebbe iniziare... a preoccuparsi, perciò fate vobis.

2. E' possibile inserire altre estensioni ( senza il punto ) sulla riga di controllo delle estensioni da prendere in esame, mettendole in OR tra loro :

'Controllo sulle estensioni dei file da importare...
If FSO.GetExtensionName(f.Path) = "xls" Then ' OR < altre estensioni Excel >...

3. Il processo nomina in automatico ogni nuovo foglio importato con un numero progressivo + il nome del file di origine. Ogni modifica al metodo con cui nominare i Fogli va fatto qui :

...
nomeFoglio = cnt & "_" & Left(nomeFile, Len(nomeFile) - Len(FSO.GetExtensionName(f.Path)) - 1)

4. La riga di eliminazione del Foglio codice, se desiderata, deve sempre essere l'ultima ad essere eseguita :

...
...
ThisWorkbook.Worksheets(1).Delete
 
End Sub

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: Excel VBA

[VB6] Gestire Controlli Image a Runtime con Drag & Drop

Descrizione :
Una tecnica interessante per gestire creazione, eliminazione, spostamento di controlli Image a runtime.

+ Articolo :

--> Form di Test :
Basta avere una Form VB6 abbastanza grande, e poi aggiungere questi controlli :

- 2 Controlli Image ( che si chiameranno "Image1" e "Image2" )
su Image1 e Image2 è necessario impostare la Proprietà DragMode=1-Automatic.

- 1 altro Controllo Image ( che si chiamerà "IMG" )
su IMG è necessario impostare le Proprietà Index=0 e Visible=False.

Image1 e Image2 sono immagini "sorgenti", ossia stanno in posizione fissa rispetto alla Form, e non possono essere eliminate.
Le immagini "derivate" si possono creare semplicemente draggando sulla Form le rispettive Image sorgenti.
Le immagini derivate possono essere spostate successivamente, ed eliminate ( tasto destro del mouse )...

--> Il codice Form :

Private mouseX As Single
Private mouseY As Single
Private indiceIMG As Integer
 
Private Function nuovaImage() As Image
 
    Dim i As Integer
    i = IMG.Count
    Load IMG(i)
    IMG(i).Visible = True
 
    Set nuovaImage = IMG(i)
 
End Function
 
Private Sub Form_Load()
 
    Image1.Picture = LoadPicture("C:\Test.bmp")
    Image2.Picture = LoadPicture("C:\Test.bmp")
 
End Sub
 
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
 
    If TypeName(Source) = "Image" Then
 
        If Source.Tag = "IMG" Then
            IMG(indiceIMG).Left = X - mouseX
            IMG(indiceIMG).Top = Y - mouseY
        Else
            Dim nI As Image
            Set nI = nuovaImage
            With nI
                .Picture = Source.Picture
                .Stretch = True
                .Width = Source.Width
                .Height = Source.Height
                .Left = X - mouseX
                .Top = Y - mouseY
                .Tag = "IMG"
                .DragMode = DragModeConstants.vbAutomatic
                '...
                '...
            End With
        End If
 
    End If
 
End Sub
 
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    mouseX = X
    mouseY = Y
 
End Sub
 
Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    mouseX = X
    mouseY = Y
 
End Sub
 
Private Sub IMG_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    If Button = vbRightButton Then Unload IMG(Index)
 
End Sub
 
Private Sub IMG_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    mouseX = X
    mouseY = Y
    indiceIMG = Index
 
End Sub

1. Con un Click destro elimino una qualsiasi Image derivata ( ma non una Image sorgente ).

2. Con il pulsante sinistro invece possiamo spostare anche le Image derivate ( che in questo caso non verranno duplicate ), per correggere errori di posizionamento.

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB6

[VB.NET] Distanza di Levenshtein

Descrizione :
Function per il calcolo della Distanza di Levenshtein.

+ Articolo :

La distanza di Levenshtein tra due stringhe A e B è il numero minimo di modifiche elementari che consentono di trasformare la A nella B.

Per modifica elementare si intende :

1. La cancellazione di un carattere
2. La sostituzione di un carattere con un altro
3. L'inserimento di un carattere

Il codice :

    Public Function Levenshtein(ByVal s As String, ByVal t As String) As Integer
 
        Dim i As Integer
        Dim j As Integer
        Dim s_i As String
        Dim t_j As String
        Dim cost As Integer
        Dim n As Integer = s.Length
        Dim m As Integer = t.Length
        If n = 0 Then Return m
        If m = 0 Then Return n
        Dim d(n, m) As Integer
 
        For i = 0 To n
            d(i, 0) = i
        Next
        For j = 0 To m
            d(0, j) = j
        Next
        For i = 1 To n
            s_i = s.Substring(i - 1, 1)
            For j = 1 To m
                t_j = t.Substring(j - 1, 1)
                If s_i = t_j Then
                    cost = 0
                Else
                    cost = 1
                End If
                d(i, j) = System.Math.Min(System.Math.Min((d((i - 1), j) + 1), (d(i, (j - 1)) + 1)), (d((i - 1), (j - 1)) + cost))
            Next
        Next
 
        Return d(n, m)
 
    End Function

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: VB.NET

[Access VBA] Su Maschere e Query Parametriche

Descrizione :
Una tecnica interessante per collegare Maschere basandosi sull'uso avanzato delle Query Parametriche e minimizzando la scrittura di codice VBA.

+ Articolo :

L'esempio si basa su una Tabella "globale", da cui prelevare i dati.
In breve, la struttura della Tabella è la seguente :

id - contatore - PK [1,2,...]
IP - testo [192.168.1.1 , 192.168.1.2 , ... ]
HOST - Testo
LOGON - Testo
DOMINIO - Testo

Nell'esempio che segue risolvo il passaggio tra la Maschera TROVA ( con 3 controlli di tipo TextBox : TIP, THOST, TLOGON ) e la Maschera VISUALIZZA ( che contiene gli stessi controlli ma in modalità sola lettura e visualizza il risultato della ricerca, un record per volta ).

Per gestire il passaggio servono veramente poche righe di VBA, e inoltre grazie all'uso di un'opportuna Query Parametrica, si risolve alla radice ogni possibile problema di errore nell'inserimento da parte dell'utente.

I due vantaggi principali di questa tecnica sono :
1. La Query Parametrica risolve implicitamente i casi d'errore inserimento utente ( TextBox vuota, formati non previsti, ecc... ), che nella peggiore ipotesi porterebbero ad un crash del processo, risparmiando parecchie righe di controllo VBA.
2. Si evita l'approccio comune di concatenare direttive Sql e valori, con tutte le eccezioni che questo può portare.

Anzitutto, la Query Parametrica. Ovviamente prende i dati dalla tabella globale.
La creo in struttura così ( un'immagine vale più di mille parole ) :


Come si vede, nei criteri di IP, HOST e LOGON, i Parametri fanno riferimento diretto ai controlli sulla Maschera TROVA. Questo accorgimento risparmia in un colpo solo decine e decine di righe VBA.
Salvo la Query e la nomino "Query_TROVA".

A questo punto la Maschera TROVA passa in automatico i propri parametri alla Maschera VISUALIZZA.

--> Maschera TROVA :

Sulla Maschera TROVA c'è il pulsante "cmd_trova", che applica i criteri dell'utente.
L'unico codice necessario è per il pulsante :

Private Sub cmd_trova_Click()

    DoCmd.OpenForm "VISUALIZZA", acNormal, , , acFormReadOnly

End Sub

Con acFormReadOnly la rendo di sola lettura, come desiderato.

--> Maschera VISUALIZZA :

La Maschera VISUALIZZA può essere creata tranquillamente a partire dalla Tabella globale, con creazione guidata. Al momento del Load(), semplicemente si andrà a ridefinire il suo RecordSource.
Perciò l'unico codice necessario è questo :

Private Sub Form_Load()

    Me.RecordSource = "Query_TROVA"

End Sub

Query_TROVA è la nostra brava Query Parametrica di cui sopra, e posso passarne il nome
come stringa direttamente al RecordSource della Maschera. Comodo no ?

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: Access VBA

[C#] Form con ControlBox Personalizzata

Descrizione :
Un semplice esempio su come ottenere una Form con ControlBox personalizzata.

+ Articolo :

Nell'esempio ho una Form con queste 3 Proprietà impostate a design :
ControlBox = False
FormBorderStyle = Sizable
Text = [nessun testo]

In questo caso voglio replicare i 3 Controlli standard della ControlBox di una Window e aggiungerne uno per poter minimizzare nella Tray.
Perciò, nell'ordine, partendo dall'angolo destro superiore della Form, vado ad aggiungere 4 Button ( quadrati - aspetto grafico a piacere... ) :

--> cmd_close
--> cmd_maximize
--> cmd_minimize
--> cmd_tray

La Proprietà Anchor su tutti questi pulsanti è = Top, Right.
Tutti i controlli aggiuntivi devono avere stesso Anchor.

Inoltre aggiungo un controllo notifyIcon1, utile per il "Minimize to Tray".

Le azioni standard nonchè lo spostamento con il mouse che viene perso eliminando la barra, possono essere replicati con poco codice.

--> Codice Form :

    public partial class Form1 : Form
    {
        public Form1()
        {
            InitializeComponent();
        }

        //Selezione e mouse
        private bool selezione = false;
        private int eXSel = 0;
        private int eYSel = 0;

        private void Form1_MouseDown(object sender, MouseEventArgs e)
        {
            this.selezione = true;
            eXSel = e.X;
            eYSel = e.Y;
        }

        private void Form1_MouseMove(object sender, MouseEventArgs e)
        {
            if (this.selezione == true)
            {
                this.Left -= (this.eXSel - e.X);
                this.Top -= (this.eYSel - e.Y);
            }
        }

        private void Form1_MouseUp(object sender, MouseEventArgs e)
        {
            this.selezione = false;
        }

        private void cmd_maximize_Click(object sender, EventArgs e)
        {
            if (this.WindowState == FormWindowState.Maximized)
            {
                this.WindowState = FormWindowState.Normal;
            }
            else 
            {
                this.WindowState = FormWindowState.Maximized;
            }
        }

        private void cmd_close_Click(object sender, EventArgs e)
        {
            this.Close();
        }

        private void cmd_minimize_Click(object sender, EventArgs e)
        {
            this.WindowState = FormWindowState.Minimized;
        }

        private void cmd_tray_Click(object sender, EventArgs e)
        {
            notifyIcon1.Visible = true;
            this.Visible = false;
        }

        private void notifyIcon1_Click(object sender, EventArgs e)
        {
            notifyIcon1.Visible = false;
            this.Visible = true;
        }
    }

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: C#

[Excel VBA] Matrice con Valori Random

Descrizione :
Come generare una Matrice quadrata con valori Random su Foglio Excel. 

+ Articolo :
Nell'esempio seguente viene generata una Matrice quadrata con valori binari [0,1], con un numero prefissato di valori "1", e con tutti "0" sulla diagonale. Il codice è abbastanza semplice e lineare da consentire facilmente qualsiasi modifica o adattamento.

Poniamo che la mia matrice 15x15 debba occupare il Range [N1:AB15], e che il numero desiderato di numeri 1 da inserire sia 20 :

    Dim WB As Worksheet 'Imposta Foglio
    Set WB = Worksheets("Foglio1")
    Dim C As Range 'Imposta Cella iniziale : angolo alto-sinistro matrice
    Set C = WB.Range("N1")
    Dim m As Integer 'Imposta dimensione matrice (quadrata)
    m = 15
    Dim num1 As Integer 'Imposta numeri 1 desiderati in matrice
    num1 = 20
    
    Dim cnt1 As Integer
    Dim indMinR As Long 'Indice minimo riga
    indMinR = C.Row
    Dim indMinC As Long 'Indice minimo colonna
    indMinC = C.Column
    Dim indMaxR As Long 'Indice max riga
    indMaxR = C.Offset(m - 1, 0).Row
    Dim indMaxC As Long 'Indice max colonna
    indMaxC = C.Offset(0, m - 1).Column
    Dim indR As Long
    Dim indC As Long
    
    WB.Range(C, C.Offset(m - 1, m - 1)) = 0
    WB.Range(C, C.Offset(m - 1, m - 1)).Interior.Color = vbWhite
       
    Do
        
        indR = RandomizzaIntero(indMinR, indMaxR)
        indC = RandomizzaIntero(indMinC, indMaxC)
        
        If WB.Cells(indR, indC).Value = 0 And (indR - C.Row) <> (indC - C.Column) Then
            WB.Cells(indR, indC).Value = 1
            WB.Cells(indR, indC).Interior.Color = vbGreen
            cnt1 = cnt1 + 1
        End If
               
    Loop Until cnt1 = num1

dove RandomizzaIntero() è la semplice Function :

Public Function RandomizzaIntero(ByVal min As Long, ByVal max As Long) As Long

    RandomizzaIntero = Int((max - min + 1) * Rnd + min)

End Function

min e max sono argomenti che permettono di selezionare un range entro cui la Function dovrà restituire il numero Long Random.
In soldoni, un RandomizzaIntero( 2, 4 ) restituirà {2,3,4} ( perciò estremi inclusi ).
In caso di argomenti invertiti, invece un RandomizzaIntero( 6, 3 ) restituirà un range di valori con estremi esclusi : {4,5}.

Il risultato sarà di questo tipo :

In pratica si Randomizza l'indirizzo di cella all'interno del Range desiderato, il che garantisce una buona distribuzione "casuale" dei valori.

Con "C" scelgo la cella da cui inizia la matrice ( cella in alto a sinistra - in questo caso N1 )
e con "m" la dimensione ( la matrice quadrata avrà m righe x m colonne ).
Offset restituisce un oggetto Range che rappresenta un intervallo distanziato dall'intervallo specificato.
Se applicato ad una cella restituisce la cella che si ottiene spostandosi dalla cella di partenza di un numero di celle defnito dai parametri (RowOffset, ColumnOffset).

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Continua a leggere »

Posted in: Excel VBA