Propósito

✔ Programação GLOBAL® - Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog devem ser tratados como consultoria freelance. Queiram contatar-nos: brazilsalesforceeffectiveness@gmail.com | ESTE BLOG NÃO SE RESPONSABILIZA POR QUAISQUER DANOS PROVENIENTES DO USO DOS CÓDIGOS AQUI POSTADOS EM APLICAÇÕES PESSOAIS OU DE TERCEIROS.

.: Vitrine

Carregando artigos...

Views

Mostrando postagens com marcador text. Mostrar todas as postagens
Mostrando postagens com marcador text. Mostrar todas as postagens

VBA Word - Formatando o Texto

VBA Word - Formatando o Texto



With Selection.Font
' the Latin text font name and size...   
        .Name = "Verdana"
        .Size = 12
' Bold and Italic are the Font Style...        
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
' The following are the font effects...       
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = True
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
' Character spacing...
        .Spacing = -1
        .Scaling = 100
        .Position = -2
        .Kerning = 12
' One of the available Annimation effects.
' Can be one of the following...
' wdAnimationBlinkingBackground
' wdAnimationLasVegasLights
' wdAnimationMarchingBlackAnts
' wdAnimationMarchingRedAnts
' wdAnimationShimmer
' wdAnimationSparkleText
' wdAnimationSparkleText
        .Animation = wdAnimationNone
The font, size, and style of Bidirectional fonts.       
        .SizeBi = 12
        .NameBi = "Tahoma"
        .BoldBi = False
        .ItalicBi = False
    End With


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

brazilsalesforceeffectiveness@gmail.com

✔ Brazil SFE®✔ Brazil SFE®´s Facebook´s Profile  Google+   Author´s Professional Profile  ✔ Brazil SFE®´s Pinterest       ✔ Brazil SFE®´s Tweets


Nenhum comentário:
Tags: , , , ,

VBA Access - Converta Números em texto


Esta função do Microsoft Access receba um valor numérico como parâmetro, o traduzirá como texto.

Esta função é muito útil em especial se você trabalhar numa empresa multinacional. 

O resultado final é um valor numérico convertida em Inglês em um formulário ou relatório.

Public Function wsiSpellNumber (ByVal MyNumber)
    Dim Dollars, Cents, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String

    Let Place(2) = " Thousand "
    Let Place(3) = " Million "
    Let Place(4) = " Billion "
    Let Place(5) = " Trillion "

    ' String representation of amount.
    Let MyNumber = Trim(Str(MyNumber))

    ' Position of decimal place 0 if none.
    Let DecimalPlace = InStr(MyNumber, ".")

    ' Convert cents and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
        Let Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
                  "00", 2))
        Let MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    Count = 1
    Do While MyNumber <> ""
        Let Temp = GetHundreds(Right(MyNumber, 3))
        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
        If Len(MyNumber) > 3 Then
            Let MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            Let MyNumber = ""
        End If
        Let Count = Count + 1
    Loop
    Select Case Dollars
        Case ""
            Let Dollars = "No Dollars"
        Case "One"
            Let Dollars = "One Dollar"
         Case Else
            Let Dollars = Dollars & " Dollars"
    End Select
    Select Case Cents
        Case ""
            Let Cents = " and No Cents"
        Case "One"
            Let Cents = " and One Cent"
              Case Else
            Let Cents = " and " & Cents & " Cents"
    End Select
    Let wsiSpellNumber = Dollars & Cents
End Function
      
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
    Dim result As String
    If Val(MyNumber) = 0 Then Exit Function
    Let MyNumber = Right("000" & MyNumber, 3)
    ' Convert the hundreds place.
    If Mid(MyNumber, 1, 1) <> "0" Then
        Let result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
    End If
    ' Convert the tens and ones place.
    If Mid(MyNumber, 2, 1) <> "0" Then
        Let result = result & GetTens(Mid(MyNumber, 2))
    Else
        Let result = result & GetDigit(Mid(MyNumber, 3))
    End If
    Let GetHundreds = result
End Function
      
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
    Dim result As String
    Let result = ""           ' Null out the temporary function value.
    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
        Select Case Val(TensText)
            Case 10: result = "Ten"
            Case 11: result = "Eleven"
            Case 12: result = "Twelve"
            Case 13: result = "Thirteen"
            Case 14: result = "Fourteen"
            Case 15: result = "Fifteen"
            Case 16: result = "Sixteen"
            Case 17: result = "Seventeen"
            Case 18: result = "Eighteen"
            Case 19: result = "Nineteen"
            Case Else
        End Select
    Else                                 ' If value between 20-99...
        Select Case Val(Left(TensText, 1))
            Case 2: result = "Twenty "
            Case 3: result = "Thirty "
            Case 4: result = "Forty "
            Case 5: result = "Fifty "
            Case 6: result = "Sixty "
            Case 7: result = "Seventy "
            Case 8: result = "Eighty "
            Case 9: result = "Ninety "
            Case Else
        End Select
        Let result = result & GetDigit _
            (Right(TensText, 1))  ' Retrieve ones place.
    End If
    Let GetTens = result
End Function
     
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
    End Select
End Function



Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...


Tags: Access, numbers, convert, text, extenso, inglês, 



Inline image 1


Nenhum comentário:
Tags: , , , , ,

VBA Excel Basic - Como tornar os texto Maiúsculos - How To Change The Text To Upper Case Or Lower Case



Sim, mais tópicos voltados para quem está iniciando na utilização do VBA - Visual Basic for Application.

Neste exemplo aprenderemos a como tornar os texto maiúsculos ou minúsculos.

Sub sbExample5() 
    
    Range("C2").Value = UCase(Range("C2").Value)
     
    Range("C3").Value = LCase(Range("C3").Value)
End Sub

Tags: VBA, Excel, worksheet, workbook, cell, Maiúsculo, Change, Text, Upper Case, Lower Case, 


Nenhum comentário:
Tags: , , , , , , , , ,

VBA Excel - Exporte como Texto delimitado




Exporte o conteúdo de uma planilha para um arquivo texto delimitando-o entre aspas duplas e vírgula:
Sub QuoteCommaExport()
    Dim DestFile As String
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer

    ' Prompt user for destination file name.
    DestFile = InputBox("Enter the destination filename" & _
      Chr(10) & "(with complete path and extension):", _
      "Quote-Comma Exporter")
    ' Obtain next free file handle number.
    FileNum = FreeFile()

    ' Turn error checking off.
    On Error Resume Next

    ' Attempt to open destination file for output.
    Open DestFile For Output As #FileNum
    ' If an error occurs report it and end.
    If Err <> 0 Then
      MsgBox "Cannot open filename " & DestFile
      End
    End If

    ' Turn error checking on.
    On Error GoTo 0

    ' Loop for each row in selection.
    For RowCount = 1 To Selection.Rows.Count
      ' Loop for each column in selection.
      For ColumnCount = 1 To Selection.Columns.Count

         ' Write current cell's text to file with quotation marks.
         Print #FileNum, """" & Selection.Cells(RowCount, _
            ColumnCount).Text & """";
         ' Check if cell is in last column.
         If ColumnCount = Selection.Columns.Count Then
            ' If so, then write a blank line.
            Print #FileNum,
         Else
            ' Otherwise, write a comma.
            Print #FileNum, ",";
         End If
      ' Start next iteration of ColumnCount loop.
      Next ColumnCount
    ' Start next iteration of RowCount loop.
    Next RowCount

    ' Close destination file.
    Close #FileNum
End Sub

Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...


Tags: VBA, Export, text, Text File, Comma, Quote, Delimiters,


Nenhum comentário:
Tags: , , , , , ,

VBA Excel - Ajuste o layout de diversas planilhas - Loop through all worksheets in all Excel workbooks in a folder to change the font, font size, and alignment of text in all cells



Gosto muito de automatizar os processos que envolvem a repetição e o retrabalho humano. Isso poupa muito tempo e dinheiro. Gastar tempo automatizando um processo é algo realmente recompensador.

Ao gerarmos diversos relatórios em planilhas diferentes (workbook) do MS Excel, não queremos perder tempo formatando-as durante a geração e processamento de tais dados. Mas podemos programar para que sejam minimamente formatadas depois que tudo terminar e todos os arquivos estiverem gravados em uma pasta do nosso servidor ou estação de trabalho. Como?

Sub FormatLayoutFiles()
    Const fPath As String = "D:\Bernardes\Docs\"

    Dim sh As Worksheet
    Dim sName As String

    With Application
        Let .Calculation = xlCalculationManual
        Let .EnableEvents = False
        Let .ScreenUpdating = False
    End With

    Let sName = Dir(fPath & "*.xls*")

    Do Until sName = ""
        With GetObject(fPath & sName)
            For Each sh In .Worksheets
                With sh
                    Let .Cells.HorizontalAlignment = xlLeft
                    Let .Cells.Font.Name = "Arial"
                    Let .Cells.Font.Size = 10
                End With
            Next sh
            .Close True
        End With

        Let sName = Dir
    Loop

    With Application
        Let .Calculation = xlAutomatic
        Let .EnableEvents = True
        Let .ScreenUpdating = True
    End With
End Sub


Tags: Excel, VBA, format, layout, fomatação, Loop, worksheets, workbooks, folder,change, font, font size, alignment, text, cells


Nenhum comentário:
Tags: , , , , , , , , , , , , , ,

VBA Excel - Criando um Log de acesso

Inline image 2



Digamos que precisemos rapidamente registrar o nome das pessoas que estão acessando um relatório, uma análise, um Dashboard contido em uma das nossas planilhas.

Rapidamente podemos inserir esta função na nossa planilha e , voià la pronto!

Caso o nosso arquivo esteja sendo aberto em uma página da intranet, o mesmo não registrará nada.

Function Rastrear()
    ' Author:                     Date:               Contact:
    ' André Bernardes             11/08/2008 09:01    bernardess@gmail.com
    ' Cria arquivo de Log.

    If Left(ThisWorkbook.Path, 4) <> "http" Then
        Open ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & ".log" For Append As #1
        Print #1, Application.UserName, Now
        Close #1
    End If
End Function

Tags: VBA, Excel, logo, txt, texto, text




Nenhum comentário:
Tags: , , , , ,

VBA Tips - Detectando conteúdo num arquivo texto externo à aplicação





Por que eu desejaria saber o conteúdo de um arquivo texto fora da minha aplicação, seja MS Excel, MS Access, MS Outlook, etc...?

Talvez precisemos medir, controlar, ou acompanhar um processo que será administrado por nossa aplicação, mas que ocorra fora dela.

Mas imagine o seguinte: Um processo em andamento, sendo executado através de Shell - Um código externo, fora da nossa aplicação, o qual não pode ser controlado através do nosso código VBA. 

Como medir em que passo está? 

Como saber se está dando certo? 

Como saber se já terminou?

Isso é bem comum, quando por exemplo executamos um Script SQL. E ao invés de usarmos um arquivo BATCH para processarmos diversos Scripts, desejamos controlar o andamento através de nossa aplicação MS Access.

Neste caso, e na maioria dos demais, podemos solicitar ao Script que retorne alguma informação como a saída do resultado do processamento para um arquivo texto. Após a análise do conteúdo deste arquivo, continuamos com a seqüência seguinte.

Ok, já entendi, mas como verificarei o conteúdo do arquivo texto?

Segue: Para usar essa função é necessário fazer referência ao Microsoft Scripting Runtime (scrrun.dll)


Function rTxtFile (sSearchText As String, sFileName As String) As Boolean

    '             Author: André Luiz Bernardes - Bernardess@gmail.com.

    '                 Date: 10/04/2011 - 16:14.

    '     Application: 

    '   Functionality: Detecta uma palavra dentro do arquivo texto.



    Dim oFSO As New FileSystemObject

    Dim oFS As Variant

    Dim sText As Variant

    Dim nParticula As Variant

    Dim Encontrou As Integer



    Set oFS = oFSO.OpenTextFile(sFileName)



    Let Encontrou = 0



    Do Until oFS.AtEndOfStream


        Let sText = UCase(oFS.ReadLine)

        Let nParticula = InStr(1, sText, sSearchText, vbTextCompare)

        

        If nParticula <> 0 Then

            Let Encontrou = Encontrou + 1

        End If


    Loop



    If Encontrou = 0 Then

        Let rTxtFile = False

    Else

        Let rTxtFile = True

    End If

End Function


Como usar:

Sub iii()

    Let encontrou = rTxtFile("Error", "C:\Bernardes\Scripts\log_100413134457.txt")

End Sub



Tags: VBA, tips, Microsoft Scripting Runtime, FileSystemObject, script, scrrun.dll, SQL, text, file, arquivo, batch, 





Nenhum comentário:
Tags: , , , , , , , , , ,
Assinar: Postagens (Atom)
diHITT - Notícias