Boa noite Rhaone, para facilitar a ajuda você deve postar os arquivos para o pessoal possa te ajudar.
Conforme solicitado aqui está o meu código copleto ... obrigado ...
Dim papel_cel As Variant
Public Sub pasta_cria()
On Error GoTo pasta_ja_tem
cNasdia = Right(Day(Date), 2)
cNasMes = Right(Month(Date), 2)
cNasAno = Right(Year(Date), 4)
cNasdia = JustStr(cNasdia, 2, "0", True)
cNasMes = JustStr(cNasMes, 2, "0", True)
cNasAno = JustStr(cNasAno, 4, "0", True)
Data = cNasAno + "-" + cNasMes + "-" + cNasdia
'pasta = ThisWorkbook.Path & "Day Trade " & Data
'pasta = ThisWorkbook.Path & "Day TradeDay Trade " & Data
'pasta = ThisWorkbook.Path & "Day TradecotspinDay Trade " & Data
pasta = ThisWorkbook.Path & "Daycotacoes_000Day Trade " & Data
MkDir pasta
pasta_ja_tem:
End Sub
Public Sub Worksheet_Calculate()
On Error GoTo deu_pau
If Range("Plan2!A1").Value = 0 Then
Exit Sub
End If
If Weekday(Date) < 2 Or Weekday(Date) > 6 Then
Exit Sub
End If
If Format(Time(), "HH:mm:ss") < "08:45:00" Or Format(Time(), "HH:mm:ss") > "18:35:00" Then
For Each papel_cel In Plan2.Range("Plan2!D12:Plan2!D142")
papel_nome = papel_cel.Value 'MsgBox papel_nome
If papel_nome = "#FIM" Then
Exit For
End If
papel_cel.Offset(0, 7).Value = 0
Next papel_cel
Plan2.Range("Plan2!A2").Value = 0
Application.ThisWorkbook.Save
Application.Quit
Exit Sub
End If
If Format(Time(), "HH:mm:ss") < "08:45:00" Then
Exit Sub
End If
If Range("Plan2!A2").Value = 0 Then
Plan2.Range("Plan2!A2").Value = 1
pasta_cria
End If
Range("Plan2!D12").Select '// papel_nome
For Each papel_cel In Plan2.Range("Plan2!D12:Plan2!D142")
On Error GoTo muito_cedo
papel_nome = papel_cel.Value 'MsgBox papel_nome
If papel_nome = "#FIM" Then
Exit For
End If
If Len(Trim$(papel_nome)) <> 0 Then
If Plan2.Range("Plan2!C5").Value = "1" Then
papel_ibovespa = Plan2.Range("Plan2!E5").Value
Else
papel_ibovespa = 0
End If
If Format(Time(), "HH:mm:ss") < "09:00:10" Then
papel_ibovespa_e = "00000,00"
End If
If Format(Time(), "HH:mm:ss") >= "09:00:10" Then
papel_ibovespa_e = Format(papel_ibovespa, "00000.00")
End If
papel_cotacao = papel_cel.Offset(0, 1).Value '// MsgBox papel_nome & " " & papel_cotacao
If papel_cotacao <> papel_cel.Offset(0, 7).Value Then
papel_cel.Offset(0, 7).Value = papel_cotacao
If papel_cel.Offset(0, -1).Value <> "X" Then
If (papel_cel.Offset(0, 6).Value = 3 Or _
papel_cel.Offset(0, 6).Value = 4 Or _
papel_cel.Offset(0, 6).Value = 5 Or _
papel_cel.Offset(0, 6).Value = 15) Then
papel_cotacao_e = Format(papel_cotacao, "00000.00")
papel_diario = papel_cel.Offset(0, -2).Value
papel_diario_e = papel_diario
papel_spread = papel_cel.Offset(0, 2).Value
papel_volume = papel_cel.Offset(0, 5).Value
papel_situac = papel_cel.Offset(0, 6).Value
If papel_spread < 0 Or papel_spread = "-" Then
papel_spread = 0
End If
papel_spread_e = Format(papel_spread, "00.00")
papel_volume_e = Format(papel_volume, "00000000000.00")
If papel_ibovespa >= 0 Then
papel_ibovespa_e = "+" + papel_ibovespa_e
End If
If papel_spread >= 0 Then
papel_spread_e = "+" + papel_spread_e
End If
ordem = papel_cel.Offset(0, -3).Value
ordem_e = Format(ordem, "000")
cNasdia = Right(Day(Date), 2)
cNasMes = Right(Month(Date), 2)
cNasAno = Right(Year(Date), 4)
cNasdia = JustStr(cNasdia, 2, "0", True)
cNasMes = JustStr(cNasMes, 2, "0", True)
cNasAno = JustStr(cNasAno, 4, "0", True)
Data = cNasAno + "-" + cNasMes + "-" + cNasdia
cNasSeg = Right(Second(Time), 2)
cNasMin = Right(Minute(Time), 2)
cNasHor = Right(Hour(Time), 2)
cNasSeg = String$(2 - Len(Trim$(cNasSeg)), "0") + Trim$(cNasSeg)
cNasMin = String$(2 - Len(Trim$(cNasMin)), "0") + Trim$(cNasMin)
cNasHor = String$(2 - Len(Trim$(cNasHor)), "0") + Trim$(cNasHor)
data_hora = cNasAno + "-" + cNasMes + "-" + cNasdia + " " + cNasHor + cNasMin + cNasSeg
pont_sai = FreeFile
pasta = ThisWorkbook.Path & "Daycotacoes_000Day Trade " & Data
arquivo = pasta & "Day Trade " & papel_nome & " " & Data & " " & ordem_e & ".txt" ' MsgBox arquivo & "=2"
Open arquivo For Append As pont_sai
linha = JustStr(papel_nome, 10, " ") & " " & _
papel_cotacao_e & " " & _
data_hora & " " & _
papel_diario_e & " " & _
papel_ibovespa_e & " " & _
papel_spread_e & " " & _
papel_volume_e & " " & _
papel_situac
'papel_com_quant_melhor_e & " " & _
'papel_ven_quant_melhor_e & " " & _
'papel_ult_quant_e & " " & _
Print #pont_sai, linha
Close pont_sai
End If 'If papel_cel.Offset(0, 6).Value == 3 Or
End If 'If papel_cel.Offset(0, -1).Value <> "X" Then
End If 'If papel_cotacao <> papel_cel.Offset(0, 7).Value Then
End If 'If Len(Trim$(papel_nome)) <> 0 Then
muito_cedo:
Next papel_cel
deu_pau:
End Sub 'For Each papel_cel In Plan2.Range("Plan2!D12:Plan2!D142")
Public Function JustStr(S, N As Integer, Optional C As String = " ", Optional P As Boolean = False) As String
'----------------------------------------------------------- -----------------------
' Insere o caracter C, N vezes, na string S, justificando-a
' S = variant que recebe os dados a justificar
' C = caracter a ser inserido na justificação - se não informado " "
' N = número de caracteres a serem devolvidos pela função
' P = indica se a justificação deve ser à Esquerda (true) ou à Direita (False - Padrão)
'----------------------------------------------------------- -----------------------
If C = vbNullString Then
C = " "
End If
If N < 1 Then
JustStr = vbNullString
Else
If P Then
JustStr = Right$(String$(N, Left$(C, 1)) & S, N)
Else
JustStr = Left$(S & String$(N, Left$(C, 1)), N)
End If
End If
End Function
Postado : 05/07/2016 12:36 am