Views

...

Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

Como Executar um Script Python a partir do VBA



A maneira mais simples é executar o interpretador Python com o comando Shell.

Shell ("python.exe " & yourScript & " " & arguments)

Existem algumas outras maneiras para executar um script Python com VBA. Dependendo do que precisarmos, será necessário esperar o final da execução para saber se ele processado sem erro.


Com Shell , assíncrona com console:
Public Sub RunPython(file As String, ParamArray args())
  Shell "python.exe """ & file & """ " & Join(args, " ")
End Sub

Com Shell , síncrona, sem console:
Public Function RunPython(file As String, ParamArray args())
  Shell "pythonw.exe """ & file & """ " & Join(args, " ")
End Function

Com WScript.Shell , síncrona, sem console e com código de saída:
Public Function RunPython(file As String, ParamArray args()) As Long
  Dim obj As Object
  Set obj = CreateObject("WScript.Shell")
  RunPython = obj.Run("pythonw.exe """ & file & """ " & Join(args, " "), 0, True)
End Function
⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 


⬛◼◾▪ CONTATO ▪

Como Logar-se a sua Medias Sociais através do MS Excel - Login to Facebook, Twitter, Google+ in IE from Excel


Entrar automaticamente em nossas Mídias Sociais, usando o IE, através do MS Excel, pode ser muito útil em nosso dia a dia. Você gostaria de fazer isso, logando-se rapidamente em redes tais como Facebook, Twitter e|ou Google+.

Às vezes ficamos ​​mentalmente cansados por digitar essas identificações de login e senhas ou por serem demasiadamente longas ou por ser necessário efetuar loginlogout muitas vezes. Sim, podemos ignorar esse pequena momento, de re-digitar nossas credenciais de login, automatizando-o com a ajuda do Excel.

Login nos Formulário e Campos comuns

Quando digitamos a URL do FB, Twitter ou qualquer tipo de página que tenha um formulário de logon, este conterá os campos:

ID de login ou ID E-mail ou número de celular

Senha

Botão de envio

NotaPor vezes haverá um CAPTCHA ou uma caixa de texto pedindo resposta a uma pergunta de segurança. Este é usado filtrar spams. Se houver qualquer forma de login com essa opção de segurança ativada, então não será capaz de usar a técnica explicada neste artigo.


Digitaremos os valores em cada um dos campos manualmente e clicaremos no botão enviar. Uma vez que o submetemos, as credenciais são transferidas para o servidor correspondente para validação.

Auto Preenchimento de formulário e clique botão Enviar

Com o código abaixo será capaz de preencher um formulário de login no Facebook. O mesmo código pode ser usado para preencher o Twitter, Google+ ou qualquer forma HTML. Tudo que precisará fazer é analisar o código fonte HTML antes de automatizar o processo de login.


Private Sub Facebook_Login_Automate()
    'Declare Variables used in Code
    Dim InetApp As Object
    Dim TagsArray As Object
    Dim TagField As Object

    'Create InternetExplorer Object and Launch App
    Set InetApp = CreateObject("InternetExplorer.Application")
    Let InetApp.Visible = True

    'Navigate to Facebook
    InetApp.Navigate "http://www.facebook.com/"

    'Internet Explorer Load Time Wait
    Do While InetApp.Busy
        Let Application.StatusBar = "Carregando Applicação. Por favor aguarde..."
        Application.Wait DateAdd("s", 1, Now)
    Loop
    Let Application.StatusBar = ""
    
    'HTML code is obtained from URL.
    'Search for tag <input> and store it details in a object.
    Set TagsArray = InetApp.document.getElementsByTagName("input")
    idx = 0
    
    'Search Fields Corresponding to 'Login id', 'Password' and 'Submit' button.
    While idx < TagsArray.Length
        If TagsArray(idx).Name = "email" Then
            Let TagsArray(idx).Value = "FB_Login_Mail_ID@mail.com"
        Else
            If TagsArray(idx).Name = "pass" Then
                Let TagsArray(idx).Value = "FB_Login_Password"
            End If
            If TagsArray(idx).Type = "submit" And _
               TagsArray(idx).Name = "" Then
                    Set TagField = TagsArray(idx)
            End If
        End If
        Let idx = idx + 1
    Wend
    
    'Click Submit Button
    TagField.Click
    
    'Login Wait Time
    Do While InetApp.Busy
        Let Application.StatusBar = "Login em Progesso. Por favor aguarde..."
        Application.Wait DateAdd("s", 1, Now)
    Loop
    Let Application.StatusBar = ""
    Let InetApp.Visible = True

    'Clear Object Data
    Set InetApp = Nothing
    Set TagField = Nothing
    Set TagsArray = Nothing

End Sub

⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 


⬛◼◾▪ CONTATO ▪

Gerando Código de Barras - Generating Code 128 Barcodes using Excel VBA


Para usar este código, precisa ter:

Módulo (Para armazenar a função UDF que chamará a partir da planilha do Excel)

Public Function Code128_Str (ByVal Str As String) As String
Dim c As Class1
Set c = New Class1
Let Code128_Str = c.Code128_Str(Str)

End Function

Módulo de classe (para armazenar o objeto de classe)

' ***    Made By Michael Ciurescu (CVMichael)   ***
'Modified by Paulo Cunha (pcunha) to work with char128.ttf on word or excel on 16/05/2011
'the font at in http://grandzebu.net/index.php?page=/informatique/codbar-en/code128.htm

' References:
' http://www.barcodeman.com/info/c128.php3

Private Enum eCode128Type
    Let eCode128_CodeSetA = 1
    Let eCode128_CodeSetB = 2
    Let eCode128_CodeSetC = 3
End Enum

Private Type tCode
    ASet As String
    BSet As String
    CSet As String
    BarSpacePattern As String
End Type

Private CodeArr() As tCode

Private Sub Class_Initialize()
    ReDim CodeArr(106)

    AddEntry 0, " ", " ", "00", Chr(32)
    AddEntry 1, "!", "!", "01", Chr(33)
    AddEntry 2, """", """", "02", Chr(34)
    AddEntry 3, "#", "#", "03", Chr(35)
    AddEntry 4, "$", "$", "04", Chr(36)
    AddEntry 5, "%", "%", "05", Chr(37)
    AddEntry 6, "&", "&", "06", Chr(38)
    AddEntry 7, "'", "'", "07", Chr(39)
    AddEntry 8, "(", "(", "08", Chr(40)
    AddEntry 9, ")", ")", "09", Chr(41)
    AddEntry 10, "*", "*", "10", Chr(42)
    AddEntry 11, "+", "+", "11", Chr(43)
    AddEntry 12, ",", ",", "12", Chr(44)
    AddEntry 13, "-", "-", "13", Chr(45)
    AddEntry 14, ".", ".", "14", Chr(46)
    AddEntry 15, "/", "/", "15", Chr(47)
    AddEntry 16, "0", "0", "16", Chr(48)
    AddEntry 17, "1", "1", "17", Chr(49)
    AddEntry 18, "2", "2", "18", Chr(50)
    AddEntry 19, "3", "3", "19", Chr(51)
    AddEntry 20, "4", "4", "20", Chr(52)
    AddEntry 21, "5", "5", "21", Chr(53)
    AddEntry 22, "6", "6", "22", Chr(54)
    AddEntry 23, "7", "7", "23", Chr(55)
    AddEntry 24, "8", "8", "24", Chr(56)
    AddEntry 25, "9", "9", "25", Chr(57)
    AddEntry 26, ":", ":", "26", Chr(58)
    AddEntry 27, ";", ";", "27", Chr(59)
    AddEntry 28, "<", "<", "28", Chr(60)
    AddEntry 29, "=", "=", "29", Chr(61)
    AddEntry 30, ">", ">", "30", Chr(62)
    AddEntry 31, "?", "?", "31", Chr(63)
    AddEntry 32, "@", "@", "32", Chr(64)
    AddEntry 33, "A", "A", "33", Chr(65)
    AddEntry 34, "B", "B", "34", Chr(66)
    AddEntry 35, "C", "C", "35", Chr(67)
    AddEntry 36, "D", "D", "36", Chr(68)
    AddEntry 37, "E", "E", "37", Chr(69)
    AddEntry 38, "F", "F", "38", Chr(70)
    AddEntry 39, "G", "G", "39", Chr(71)
    AddEntry 40, "H", "H", "40", Chr(72)
    AddEntry 41, "I", "I", "41", Chr(73)
    AddEntry 42, "J", "J", "42", Chr(74)
    AddEntry 43, "K", "K", "43", Chr(75)
    AddEntry 44, "L", "L", "44", Chr(76)
    AddEntry 45, "M", "M", "45", Chr(77)
    AddEntry 46, "N", "N", "46", Chr(78)
    AddEntry 47, "O", "O", "47", Chr(79)
    AddEntry 48, "P", "P", "48", Chr(80)
    AddEntry 49, "Q", "Q", "49", Chr(81)
    AddEntry 50, "R", "R", "50", Chr(82)
    AddEntry 51, "S", "S", "51", Chr(83)
    AddEntry 52, "T", "T", "52", Chr(84)
    AddEntry 53, "U", "U", "53", Chr(85)
    AddEntry 54, "V", "V", "54", Chr(86)
    AddEntry 55, "W", "W", "55", Chr(87)
    AddEntry 56, "X", "X", "56", Chr(88)
    AddEntry 57, "Y", "Y", "57", Chr(89)
    AddEntry 58, "Z", "Z", "58", Chr(90)
    AddEntry 59, "[", "[", "59", Chr(91)
    AddEntry 60, "\", "\", "60", Chr(92)
    AddEntry 61, "]", "]", "61", Chr(93)
    AddEntry 62, "^", "^", "62", Chr(94)
    AddEntry 63, "_", "_", "63", Chr(95)
    AddEntry 64, Chr(0), "`", "64", Chr(96) ' Null
    AddEntry 65, Chr(1), "a", "65", Chr(97) ' SOH
    AddEntry 66, Chr(2), "b", "66", Chr(98) ' STX
    AddEntry 67, Chr(3), "c", "67", Chr(99) ' ETX
    AddEntry 68, Chr(4), "d", "68", Chr(100) ' EOT
    AddEntry 69, Chr(5), "e", "69", Chr(101) ' ENQ
    AddEntry 70, Chr(6), "f", "70", Chr(102) ' ACK
    AddEntry 71, Chr(7), "g", "71", Chr(103) ' BEL
    AddEntry 72, Chr(8), "h", "72", Chr(104) ' BS
    AddEntry 73, Chr(9), "i", "73", Chr(105) ' HT
    AddEntry 74, Chr(10), "j", "74", Chr(106) ' LF
    AddEntry 75, Chr(11), "k", "75", Chr(107) ' VT
    AddEntry 76, Chr(12), "l", "76", Chr(108) ' FF
    AddEntry 77, Chr(13), "m", "77", Chr(109) ' CR
    AddEntry 78, Chr(14), "n", "78", Chr(110) ' SO
    AddEntry 79, Chr(15), "o", "79", Chr(111) ' SI
    AddEntry 80, Chr(16), "p", "80", Chr(112) ' DLE
    AddEntry 81, Chr(17), "q", "81", Chr(113) ' DC1
    AddEntry 82, Chr(18), "r", "82", Chr(114) ' DC2
    AddEntry 83, Chr(19), "s", "83", Chr(115) ' DC3
    AddEntry 84, Chr(20), "t", "84", Chr(116) ' DC4
    AddEntry 85, Chr(21), "u", "85", Chr(117) ' NAK
    AddEntry 86, Chr(22), "v", "86", Chr(118) ' SYN
    AddEntry 87, Chr(23), "w", "87", Chr(119) ' ETB
    AddEntry 88, Chr(24), "x", "88", Chr(120) ' CAN
    AddEntry 89, Chr(25), "y", "89", Chr(121) ' EM
    AddEntry 90, Chr(26), "z", "90", Chr(122) ' SUB
    AddEntry 91, Chr(27), "{", "91", Chr(123) ' ESC
    AddEntry 92, Chr(28), "|", "92", Chr(124) ' FS
    AddEntry 93, Chr(29), "}", "93", Chr(125) ' GS
    AddEntry 94, Chr(30), "~", "94", Chr(126) ' RS
    AddEntry 95, Chr(31), Chr(127), "95", Chr(200) ' US, DEL
    AddEntry 96, "FNC 3", "FNC 3", "96", Chr(201)
    AddEntry 97, "FNC 2", "FNC 2", "97", Chr(202)
    AddEntry 98, "SHIFT", "SHIFT", "98", Chr(203)
    AddEntry 99, "CODE C", "CODE C", "99", Chr(204)
    AddEntry 100, "CODE B", "FNC 4", "CODE B", Chr(205)
    AddEntry 101, "FNC 4", "CODE A", "CODE A", Chr(206)
    AddEntry 102, "FNC 1", "FNC 1", "FNC 1", Chr(207)
    AddEntry 103, "Start A", "Start A", "Start A", Chr(208)
    AddEntry 104, "Start B", "Start B", "Start B", Chr(209)
    AddEntry 105, "Start C", "Start C", "Start C", Chr(210)
    AddEntry 106, "Stop", "Stop", "Stop", Chr(211)
End Sub

Private Sub AddEntry (ByVal Index As Integer, ASet As String, BSet As String, CSet As String, BarSpacePattern As String)
    With CodeArr(Index)
        Let .ASet = ASet
        Let .BSet = BSet
        Let .CSet = CSet
        Let .BarSpacePattern = Replace(BarSpacePattern, " ", "")
    End With
End Sub

Public Function Code128_Str(ByVal Str As String)
    Let Code128_Str = Replace(BuildStr(Str), " ", "")
End Function

Private Function BuildStr(ByVal Str As String) As String
    Dim SCode As eCode128Type, PrevSCode As eCode128Type
    Dim CurrChar As String, ArrIndex As Integer, CharIndex As Long
    Dim CheckDigit As Integer, CCodeIndex As Integer, TotalSum As Long

    SCode = eCode128_CodeSetB
    If Str Like "##*" Then SCode = eCode128_CodeSetC

    Let TotalSum = 0
    Let CharIndex = 1

    Select Case SCode
    Case eCode128_CodeSetA
        Let TotalSum = TotalSum + (103 * CharIndex)
        Let BuildStr = Trim(BuildStr) & Chr(208)
    Case eCode128_CodeSetB
        Let TotalSum = TotalSum + (104 * CharIndex)
        Let BuildStr = Trim(BuildStr) & Chr(209)
    Case eCode128_CodeSetC
        Let TotalSum = TotalSum + (105 * CharIndex)
        Let BuildStr = Trim(BuildStr) & Chr(210)
    End Select

    PrevSCode = SCode

    Do Until Len(Str) = 0
        If Str Like "####*" Then SCode = eCode128_CodeSetC

        If SCode = eCode128_CodeSetC And Mid(Str, 1, 2) Like "##" Then
            Let CurrChar = Mid(Str, 1, 2)
        Else
            Let CurrChar = Mid(Str, 1, 1)
        End If

        Let ArrIndex = GetCharIndex(CurrChar, SCode, True)

        If ArrIndex <> -1 Then
            If CodeArr(ArrIndex).BSet = CurrChar And ((SCode = eCode128_CodeSetC And CodeArr(ArrIndex).CSet <> CurrChar) Or (SCode = eCode128_CodeSetA And CodeArr(ArrIndex).ASet <> CurrChar)) Then
                Let SCode = eCode128_CodeSetB
            ElseIf CodeArr(ArrIndex).ASet = CurrChar And CodeArr(ArrIndex).BSet <> CurrChar Then
                Let SCode = eCode128_CodeSetA
            ElseIf CodeArr(ArrIndex).CSet = CurrChar Then
                Let SCode = eCode128_CodeSetC
            End If

            If PrevSCode <> SCode Then
                Select Case SCode
                Case eCode128_CodeSetA
                    Let CCodeIndex = GetCharIndex("CODE A", PrevSCode, False)
                Case eCode128_CodeSetB
                    Let CCodeIndex = GetCharIndex("CODE B", PrevSCode, False)
                Case eCode128_CodeSetC
                    Let CCodeIndex = GetCharIndex("CODE C", PrevSCode, False)
                End Select

                Let TotalSum = TotalSum + (CCodeIndex * CharIndex)
                Let BuildStr = Trim(BuildStr) & CodeArr(CCodeIndex).BarSpacePattern
                Let CharIndex = CharIndex + 1
                Let PrevSCode = SCode
            End If

            Let BuildStr = Trim(BuildStr) & CodeArr(ArrIndex).BarSpacePattern

            Let TotalSum = TotalSum + (ArrIndex * CharIndex)
            Let CharIndex = CharIndex + 1
        End If

        If SCode = eCode128_CodeSetC Then
            Let Str = Mid(Str, 3)
        Else
            Let Str = Mid(Str, 2)
        End If
    Loop

    Let CheckDigit = TotalSum Mod 103

    Let BuildStr = Trim(BuildStr) & CodeArr(CheckDigit).BarSpacePattern
    Let BuildStr = Trim(BuildStr) & Chr(211)
End Function

Private Function GetCharIndex (ByVal Char As String, ByVal CodeType As eCode128Type, ByVal Recurse As Boolean) As Integer
    Dim K As Long

    Select Case CodeType
    Case eCode128_CodeSetA
        For K = 0 To UBound(CodeArr)
            If Char = CodeArr(K).ASet Then Exit For
        Next K
    Case eCode128_CodeSetB
        For K = 0 To UBound(CodeArr)
            If Char = CodeArr(K).BSet Then Exit For
        Next K
    Case eCode128_CodeSetC
        For K = 0 To UBound(CodeArr)
            If Char = CodeArr(K).CSet Then Exit For
        Next K
    End Select

    If K = UBound(CodeArr) + 1 Then
        If Not Recurse Then
            Let GetCharIndex = -1
        Else
            Select Case CodeType
            Case eCode128_CodeSetA
                Let GetCharIndex = GetCharIndex(Char, eCode128_CodeSetC, False)
            Case eCode128_CodeSetB
                Let GetCharIndex = GetCharIndex(Char, eCode128_CodeSetA, False)
            Case eCode128_CodeSetC
                Let GetCharIndex = GetCharIndex(Char, eCode128_CodeSetB, False)
            End Select

            If GetCharIndex = -1 Then
                Select Case CodeType
                Case eCode128_CodeSetA
                    Let GetCharIndex = GetCharIndex(Char, eCode128_CodeSetB, False)
                Case eCode128_CodeSetB
                    Let GetCharIndex = GetCharIndex(Char, eCode128_CodeSetC, False)
                Case eCode128_CodeSetC
                    Let GetCharIndex = GetCharIndex(Char, eCode128_CodeSetA, False)
                End Select
            End If
        End If
    Else
        Let GetCharIndex = K
    End If
End Function

Public Function Code128_GetWidth (ByVal Str As String, Optional ByVal BarWidth As Integer = 1) As Long
    Dim K As Long, Width As Long

    Str = Replace(Code128_Str(Str), " ", "")
    Debug.Print Str
    For K = 1 To Len(Str)
        Let Width = Width + Val(Mid(Str, K, 1))
    Next K

    Let Code128_GetWidth = Width * BarWidth + (28 * BarWidth)
End Function

Private Sub Class_Terminate()

End Sub



⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 


⬛◼◾▪ CONTATO ▪

eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine