Personal tools

Difference between revisions of "Vba"

From MohidWiki

Jump to: navigation, search
(→‎Examples)
 
(11 intermediate revisions by the same user not shown)
Line 1: Line 1:
 
[[vba]] or visual-basic for applications is a scripting/programming language and development environment embedded within the Office suite software from microsoft. The syntax is equivalent to visual-basic, but the libraries and functions give direct access to the objects of the Office environment.
 
[[vba]] or visual-basic for applications is a scripting/programming language and development environment embedded within the Office suite software from microsoft. The syntax is equivalent to visual-basic, but the libraries and functions give direct access to the objects of the Office environment.
 +
 +
==Examples==
 +
 +
===Sum an array===
 +
''Pt()'' is a VBA array
 +
<htm>
 +
<pre name="code" class="vb">
 +
Dim Pt() as Double
 +
ReDim Pt(1 to 10)
 +
Cells(2, 2) = WorksheetFunction.Sum(Pt)
 +
</pre>
 +
</htm>
 +
 +
===Write an array in the worksheet===
 +
The quick way to write a VBA array in the excel worksheet is by using the ''Range'' method:
 +
<htm>
 +
<pre name="code" class="vb">
 +
Dim Pt() as Double
 +
ReDim Pt(1 to 10)
 +
Range(Cells(1, 1), Cells(1, 10)) = Pt
 +
</pre>
 +
</htm>
  
 
==Sample code==
 
==Sample code==
 +
===Delete text===
 +
Subroutine that deletes text in excel.
 +
<htm>
 +
<pre name="code" class="vb">
 +
'Rotina que apaga todos os valores na tabela de Excel
 +
Public Sub ApagaTexto()
 +
 +
    Range(Cells(1, 5), Range("E1:E1").End(xlToRight).End(xlDown)).ClearContents
 +
 +
End Sub
 +
</pre>
 +
</htm>
 +
 +
===Delete charts===
 
Subroutine that deletes all charts present in excel sheet
 
Subroutine that deletes all charts present in excel sheet
 
<htm>
 
<htm>
Line 18: Line 54:
  
 
     Next
 
     Next
 +
 +
End Sub
 +
</pre>
 +
</htm>
 +
 +
===Create chart===
 +
Simple subroutine that creates a chart
 +
<htm>
 +
<pre name="code" class="vb">
 +
'Rotina que faz gráfico
 +
Sub fazGrafico(nRows As Long, nCols As Long)
 +
 +
    ActiveSheet.Shapes.AddChart.Select
 +
    ActiveChart.SetSourceData Source:=Range(Cells(2, 6), Cells(nRows + 1, nCols + 5)), _
 +
        PlotBy:=xlRows
 +
    ActiveChart.ChartType = xlLine
 +
    ActiveChart.SeriesCollection(1).XValues = Range(Cells(1, 6), Cells(1, nCols + 5))
 +
 +
End Sub
 +
</pre>
 +
</htm>
 +
 +
Complex subroutine that creates a nice chart
 +
<htm>
 +
<pre name="code" class="vb">
 +
'Rotina que cria um grafico na mesma folha que a chama
 +
Sub makegraphic(lineSpan, colSpan As Integer, _
 +
                strtLine, strtCol As Integer, _
 +
                yScale As Single)
 +
   
 +
    Dim graphic As Chart                'Cria uma variavel de grafico
 +
    Dim i As Single
 +
 +
    'Cria um gráfico dentro da active sheet
 +
    Set graphic = ActiveSheet.ChartObjects.Add _
 +
        (Left:=60, Width:=500, Top:=100, Height:=300).Chart
 +
   
 +
    With graphic
 +
   
 +
        .ChartType = xlLine
 +
        .SetSourceData _
 +
            Source:=Range(Cells(strtLine, strtCol), Cells(strtLine - 1 + lineSpan, strtCol - 1 + colSpan)), _
 +
            PlotBy:=xlRows
 +
       
 +
        'define as abcissas
 +
        .SeriesCollection(1).XValues = Range(Cells(strtLine - 1, strtCol), Cells(strtLine - 1, strtCol - 1 + colSpan))
 +
       
 +
        'Põe os eixos
 +
        .HasTitle = True
 +
        .ChartTitle.Characters.Text = "Crescimento de flores numa estufa"
 +
        .Legend.Clear
 +
       
 +
        With .Axes(xlCategory, xlPrimary)
 +
            .HasTitle = True
 +
            .AxisTitle.Characters.Text = "Domínio (m)"
 +
        End With
 +
       
 +
        With .Axes(xlValue)
 +
            .HasTitle = True
 +
            .AxisTitle.Characters.Text = "Tamanho (cm)"
 +
            .TickLabels.NumberFormat = "0.0"
 +
            .MaximumScale = yScale
 +
            .MinimumScale = 0#
 +
        End With
 +
     
 +
    End With
 +
   
 +
 +
End Sub
 +
</pre>
 +
</htm>
 +
 +
===Thomas algorithm===
 +
The Thomas algorithm efficiently solves linear systems of equations who possess a tridiagonal matricial representation.
 +
<htm>
 +
<pre name="code" class="vb">
 +
'----------------------------------------------------------------------------------------------------
 +
'Este algoritmo resolve a equação:
 +
'concent (i+1)*e_coef(i) + concent(i) * p_coef(i) + concent(i-1)*w_coef(i) = Ti(i)
 +
'Referência (wikipedia): http://en.wikipedia.org/wiki/Tridiagonal_matrix_algorithm
 +
'----------------------------------------------------------------------------------------------------
 +
Sub Thomas(ByRef e_coef() As Double, _
 +
            ByRef p_coef() As Double, _
 +
            ByRef w_coef() As Double, _
 +
            ByRef TI() As Double)
 +
 +
Dim PF() As Double
 +
Dim QF() As Double
 +
 +
Dim U As Long
 +
Dim L As Long
 +
 +
Dim j As Long
 +
 +
U = UBound(e_coef)
 +
L = LBound(e_coef)
 +
 +
ReDim PF(L To U) As Double
 +
ReDim QF(L To U) As Double
 +
 +
PF(L) = -e_coef(L) / p_coef(L)
 +
QF(L) = TI(L) / p_coef(L)
 +
 +
  For j = L + 1 To U
 +
  PF(j) = -e_coef(j) / (p_coef(j) + w_coef(j) * PF(j - 1))
 +
  QF(j) = (TI(j) - w_coef(j) * QF(j - 1)) / (p_coef(j) + w_coef(j) * PF(j - 1))
 +
  Next
 +
 +
 +
TI(U) = QF(U)
 +
 +
For j = U - 1 To L Step -1
 +
  TI(j) = PF(j) * TI(j + 1) + QF(j)
 +
Next
  
 
End Sub
 
End Sub

Latest revision as of 08:38, 30 April 2010

vba or visual-basic for applications is a scripting/programming language and development environment embedded within the Office suite software from microsoft. The syntax is equivalent to visual-basic, but the libraries and functions give direct access to the objects of the Office environment.

Examples

Sum an array

Pt() is a VBA array 

Dim Pt() as Double
ReDim Pt(1 to 10)
Cells(2, 2) = WorksheetFunction.Sum(Pt)


Write an array in the worksheet

The quick way to write a VBA array in the excel worksheet is by using the Range method: 

Dim Pt() as Double
ReDim Pt(1 to 10)
Range(Cells(1, 1), Cells(1, 10)) = Pt


Sample code

Delete text

Subroutine that deletes text in excel. 

'Rotina que apaga todos os valores na tabela de Excel
Public Sub ApagaTexto()

    Range(Cells(1, 5), Range("E1:E1").End(xlToRight).End(xlDown)).ClearContents

End Sub


Delete charts

Subroutine that deletes all charts present in excel sheet 

'Rotina que apaga os gráficos existentes
Public Sub apagaGrafico()

    'Iterador de tipo "gráfico"
    Dim Chart As ChartObject

    'Para cada gráfico dentro da colecção de gráficos da ActiveSheet ...
    For Each Chart In ActiveSheet.ChartObjects

        '... apaga o gráfico.
        Chart.Delete

    Next

End Sub


Create chart

Simple subroutine that creates a chart 

'Rotina que faz gráfico
Sub fazGrafico(nRows As Long, nCols As Long)

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range(Cells(2, 6), Cells(nRows + 1, nCols + 5)), _
        PlotBy:=xlRows
    ActiveChart.ChartType = xlLine
    ActiveChart.SeriesCollection(1).XValues = Range(Cells(1, 6), Cells(1, nCols + 5))

End Sub


Complex subroutine that creates a nice chart 

'Rotina que cria um grafico na mesma folha que a chama
Sub makegraphic(lineSpan, colSpan As Integer, _
                strtLine, strtCol As Integer, _
                yScale As Single)
    
    Dim graphic As Chart                'Cria uma variavel de grafico
    Dim i As Single

    'Cria um gráfico dentro da active sheet
    Set graphic = ActiveSheet.ChartObjects.Add _
        (Left:=60, Width:=500, Top:=100, Height:=300).Chart
    
    With graphic
    
        .ChartType = xlLine
        .SetSourceData _
            Source:=Range(Cells(strtLine, strtCol), Cells(strtLine - 1 + lineSpan, strtCol - 1 + colSpan)), _
            PlotBy:=xlRows
        
        'define as abcissas
        .SeriesCollection(1).XValues = Range(Cells(strtLine - 1, strtCol), Cells(strtLine - 1, strtCol - 1 + colSpan))
        
        'Põe os eixos
        .HasTitle = True
        .ChartTitle.Characters.Text = "Crescimento de flores numa estufa"
        .Legend.Clear
        
        With .Axes(xlCategory, xlPrimary)
            .HasTitle = True
            .AxisTitle.Characters.Text = "Domínio (m)"
        End With
        
        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Characters.Text = "Tamanho (cm)"
            .TickLabels.NumberFormat = "0.0"
            .MaximumScale = yScale
            .MinimumScale = 0#
        End With
       
    End With
    

End Sub


Thomas algorithm

The Thomas algorithm efficiently solves linear systems of equations who possess a tridiagonal matricial representation. 

'----------------------------------------------------------------------------------------------------
'Este algoritmo resolve a equação:
'concent (i+1)*e_coef(i) + concent(i) * p_coef(i) + concent(i-1)*w_coef(i) = Ti(i)
'Referência (wikipedia): http://en.wikipedia.org/wiki/Tridiagonal_matrix_algorithm
'----------------------------------------------------------------------------------------------------
Sub Thomas(ByRef e_coef() As Double, _
            ByRef p_coef() As Double, _
            ByRef w_coef() As Double, _
            ByRef TI() As Double)

Dim PF() As Double
Dim QF() As Double

Dim U As Long
Dim L As Long

Dim j As Long

U = UBound(e_coef)
L = LBound(e_coef)

ReDim PF(L To U) As Double
ReDim QF(L To U) As Double
 
 PF(L) = -e_coef(L) / p_coef(L)
 QF(L) = TI(L) / p_coef(L)

  For j = L + 1 To U
   PF(j) = -e_coef(j) / (p_coef(j) + w_coef(j) * PF(j - 1))
   QF(j) = (TI(j) - w_coef(j) * QF(j - 1)) / (p_coef(j) + w_coef(j) * PF(j - 1))
  Next


 TI(U) = QF(U)

 For j = U - 1 To L Step -1
  TI(j) = PF(j) * TI(j + 1) + QF(j)
 Next

End Sub


External links

Retrieved from "https://wiki.mohid.com/index.php?title=Vba&oldid=2999"