EXCELer

Se pretendermos inserir uma imagem numa folha de cálculo e dentro de uma "Image box control", como no exemplo:








podemos utilizar um pouco de Código:

Option Explicit


Private Sub CommandButton1_Click()

    Dim myPictName As Variant
    Dim Image1 As Image

    myPictName = Application.GetOpenFilename _
                    (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif")
    If myPictName = False Then
        Exit Sub
    End If


   Me.Image1.Picture = LoadPicture(myPictName)

End Sub

Se numa tabela de nomes pretendermos filtrar um determinado nome (ex: António), o qual pode ser nome próprio, nome do meio ou apelido, podemos utilizar um pouco de VBA:












O Código:

Private Sub CommandButton1_Click()
Dim myName

    Range("A1:A700").Select
    myName = InputBox(Prompt:="Digite o nome para filtro ou carregue em OK para remover filtro", Title:="Filtra por nome")

    If myName = "" Then
        Selection.AutoFilter
        Range("A1").Select
    Else
        Selection.AutoFilter Field:=1, Criteria1:="*" & myName & "*", Operator:=xlAnd
        Range("A1").Select
    End If

End Sub


NOTA: O asterisco funciona como um "multi character wild card".

Tópicos relacionados

 WildCards (1) (Microsoft Support Center)

 WildCards (2) (digdb.com)

 Filtros (1) (por Debra Dalgleish)

 Filtro (2) (Joseph Rubin's Exceltip.com)

O Código:

Private Sub CommandButton1_Click()
    Dim strTemp As String

    On Error GoTo CommandButton1_Click_Error

    Open "F:\Gabinete\teste.txt" For Input As #1

    Line Input #1, strTemp
    Range("A1").Value = strTemp + 1
    Close #1

    Open "F:\Gabinete\teste.txt" For Output As #1

    strTemp = Range("A1").Value
    Print #1, strTemp
    Close #1

    On Error GoTo 0
    Exit Sub

CommandButton1_Click_Error:

    MsgBox "Erro " & Err.Number & " (" & Err.Description & ") no procedimento CommandButton1_Click"
End Sub

Tópicos relacionados:

 Open Statement

Consideremos o seguinte sistema de equações: x + y =8 e x - y = 2

Assim, na 2ª equação, teriamos: x= y+2. Então, na 1ª equação teríamos com a substituição de x: y + 2 + y = 8 ou seja: 2y = 6 ou seja: y = 6/2 ou seja: y = 3

Então, na 2ª equação teríamos com a substituição de y pelo seu resultado: x - 3 = 2 ou seja: x = 5

Como resolver este problema no Excel?

Com a ajuda do Add-in SOLVER, é possível. Vejamos o exemplo:

Nota - definiu-se C2 como x e C3 como y (Insert|Name|Define)
            B2 é igual a 8, ou seja: x + y
            B3 é igual a 2, ou seja: x - y








O resultado:

Utilizando o Excel:

A célula A1 será a incógnita (x). Digitamos o valor 0 (zero)

Em B1: =A1+A1+A1/4+1



Utilizando o comando Goal Seek:



O valor colocado no campo "To value" faz parte da equação (100):

Sabendo como funciona o Operador de Divisão Inteiro (\), então, podemos construir uma UDF, que mais não é do que a Função do Excel denominada QUOTIENT().

Vejamos o exemplo no seguinte screenshot:




O Código da Função IntDiv():

Function IntDiv(ByVal vStr As Double, vStr1 As Double) As Double


    Dim oStr As String

    oStr = vStr \ vStr1

    IntDiv = oStr

End Function

Nota -

Vejamos o exemplo:




O Código da função Teste():

Function Teste()

    Dim oDbl As Double
    Dim vA1 As Double
    Dim vA2 As Double

    vA1 = Range("a1")
    vA2 = Range("a2")

    oDbl = vA1 \ vA2

    Teste = oDbl

End Function

Tópicos relacionados:

 Integer Division (\)

 Function Quotient()

 Function Mod()

 Function Round()

Podemos utilizar o seguinte Código:


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

    Dim tabela As Range
    Dim nomeLista As Range
    Dim cell As Range

    Set tabela = Range("B1:B20")
    Set nomeLista = Range("D10:H10")

    tabela.Interior.ColorIndex = 0
    If Target.Count = 1 Then
        If Not Intersect(Target, nomeLista) Is Nothing Then
            For Each cell In tabela
                If cell.Value = Target.Value Then
                    cell.Interior.ColorIndex = 5
                End If
            Next cell
        End If
    End If

End Sub


Nota: O Código deve ser inserido no próprio módulo da Sheet activa.

Tópicos relacionados:

 Cell Colors

 Color Palette & ColorIndex

O Código:

Declare Function GetKeyboardState Lib "user32" _
                                  (pbKeyState As Byte) As Long
Declare Function SetKeyboardState Lib "user32" _
                                  (lppbKeyState As Byte) As Long

Sub Abrir()
    Dim User As String
    Dim Res As Long
    Dim KBState(0 To 255) As Byte


    Res = GetKeyboardState(KBState(0))
    KBState(&H14) = 1  ' 1 para "on", 0 para "off"; &H14 (CapsLock) &H90 (NumLock)



    Sheets("Progressivo").Select

    Do While User = ""
        User = InputBox(Prompt:="Digite o seu nome e Enter para continuar", Title:="Nome")
    Loop

    Range("O34").Select
    ActiveCell.FormulaR1C1 = User
    
    KBState(&H14) = 0  ' 1 para "on", 0 para "off"

    Res = SetKeyboardState(KBState(0))

End Sub

Tópicos relacionados:

  Num Lock, Caps Lock e Scroll Lock Toogle

  Windows API Functions