Bom dia !
Adoro este forum por essa razao, aqui nao ficamos sem as devidas respostas.
1- Por enquanto ele possui 3.350Kb
2- Os codigos muito gramde que vc se refere sao os que estao dentro da Macro ? Segue abaixo a minha Macro ao processar, deixei na medida do possivel o mais Light , com a ajuda de vcs é claro.
3- QTD de dados , de fato tenho o cadastro de clientes que por enquanto esta ainda em 36 cadastros, e 129 produtos cadastrados.
4- Excesso de formulas, ai que é meu calcanhar de aquiles, pois eu de fato exagero demais, porque gosto de ter todos os recursos na mesma planilha.
5 - O Excesso de imagens é outro detalhe, pois na tela de vendas ao digitar o COD do produto, coloco o mesmo na coluna ao lado aparecendo sua imagem usando o Gerenciador de nomes com cada linha usando : =ÍNDICE(Estoque!$A$6:$A$973;CORRESP(Venda1!$B$21;Estoque!$B$6:$B$973;0)). Sao 15 linhas a tela de entrada de Vendas. Sendo que possuo 3 telas de vendas, e assim posso verder ao mesmo tempo a tres clientes, fiz isso para enquanto 1 cliente mantem a tela aberta vou fazendo venda nas 2 demais. Pensei em puchar a imagem sem usar a formula acima no gerenciador de nomes, ou ate mesmo nao aparecer foto alguma, e assim ver se melhora um pouco. Pois a cada vez que entro com um codigo de produto, é uma manivela.
6- Memoria tenho 2 pentes de 2Mb, e um note book Vaio Core I7.
7- Uso o Windows 7
8- Ja pensei em usar os 2 Acess e Excel integrados, mas nao sei como fazer , teria que comecar do zero de novo, e na altura que esta planilha esta é complicado. E nao sou apto a trabalhar com Acess, teria que assistir muito video youtube e encher o saco aqui de vcs, ja imaginou isso ?
9- Tb acho que transformar em Exe. nao seria o ideal, pois estou sempre inventando algo e concertando os Bugs que ficam pelo meio do caminho.
nem sei o que fazer, pois preciso que a planilha rode rapido, pra venda ser rapida. Ate pra cadastrar um cliente novo demora pacas. Pois acredito que mesmo se cadastrando um clinte e nao envolvendo a tela de vendas, mesmo assim o Excel faz a atualizacao em toda a planilha, correto ?
Andre
Comando que dar baixa no banco de dados do Site feito em WordPress
Sub final()
End Sub
Sub site()
Run "ExecutarEnvioParaWebsite"
End Sub
Public Function ExecutarEnvioParaWebsite()
Dim i As Integer
For i = 72 To 86
ProcessarDados (i)
Next i
End Function
Public Function ProcessarDados(loopAtual As Integer)
Dim sku, sale_price, price, qnt, active, passwd, stringCompleta As String
sku = Range("E" & loopAtual).Value
If sku = "" Then
GoTo fim
Else: End If
sale_price = "NULL"
qnt = Range("G" & loopAtual).Value
price = "NULL"
active = "3"
passwd ="SENHA USADA"
stringCompleta = "sku=" & sku & "&sale_price=" & sale_price & "&price=" & price & "&qnt=" & qnt & "&active=" & active & "&passwd=" & passwd
EnviarParaWebsite (stringCompleta)
fim:
End Function
Public Function EnviarParaWebsite(stringCompleta As String)
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "URL"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.Send (stringCompleta)
End Function
Macro que processa a venda feita, chama a Macro acima, da baixa no estoque, lanca os itens em produtos mais . menos vendidos, adiciona a venda ao cliente, lanca os detalhes da venda em "Vendas Feitas"
Sub Processar_SIMPLIFICADO()
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'desabilite o alerta
Application.DisplayStatusBar = False 'Desabilita atualização da barra de status
Application.Calculation = xlManual 'Desativa modo automático de cálculo
Application.EnableEvents = False 'Desativa os eventos no excel
ActiveSheet.DisplayPageBreaks = False 'Habilita as quebras de páginas
'---------------------------------------------------------------------------------
Dim nome
nome = Range("B1").Value
Sheets(nome).Activate 'Select
Sheets("Clientes").Visible = True
Sheets("Vendas Feitas").Visible = True
'-----------------------------------------------------------
If Range("B2").Value = "" Then
MsgBox ("INSIRA A EMPRESA !")
GoTo Terminar
Else
End If
If Range("B5").Value = "" Then
MsgBox ("INSIRA UM PRODUTO !")
GoTo Terminar
Else
End If
If Range("L2").Value = 1 Then
MsgBox ("ESCOLHA UM CLIENTE #1 !")
GoTo Terminar
Else
End If
If Range("U6").Value = 1 Then
MsgBox ("ESCOLHA A FORMA DE PAGAMENTO !")
GoTo Terminar
Else
End If
'-------------------------------------------------------------------------
' Macro que dar a Baixa no site dos itens Vendidos
Run "Site"
MsgBox "O Site foi Atualizado com Sucesso !"
'-------------------------------------------------------------------------
Sheets(nome).Activate 'Select
'---------------------------------------------------------------------
' Parte 0
'---------------------------------------------------------------------
' Gerar Consultas Nutricionista
'---------------------------------------------------------------------
Sheets("Categoria").Visible = True
Dim NU, NR As Worksheet
Dim Contar As Long
Dim Consulta As String
Set NU = Worksheets("Categoria")
Set NR = Worksheets(nome)
Consulta = NR.Range("L6").Value
Sheets("Categoria").Visible = True
NU.Activate
NU.Range("B5").Activate
Do While ActiveCell <> ""
If ActiveCell = Consulta Then
ActiveCell.Offset(0, 3).Activate
Contar = ActiveCell
Contar = Contar + 1
ActiveCell = Contar
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop
NR.Activate
Set NU = Nothing
Set NR = Nothing
Sheets("Categoria").Visible = False
Sheets(nome).Select
'---------------------------------------------------------------------
' Parte 1
'---------------------------------------------------------------------
' Gerar Vendas ao Cliente
'---------------------------------------------------------------------
Sheets("Clientes").Visible = True
'Sheets("Clientes").Unprotect "123"
Dim WC, WR As Worksheet
Dim Cont As Long
Dim Venda As String
Set WC = Worksheets("CLIENTES")
Set WR = Worksheets(nome)
Venda = WR.Range("L6").Value
Sheets("CLIENTES").Visible = True
WC.Activate
WC.Range("B3").Activate
Do While ActiveCell <> ""
If ActiveCell = Venda Then
ActiveCell.Offset(0, 18).Activate
Cont = ActiveCell
Cont = Cont + 1
ActiveCell = Cont
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop
WR.Activate
Set WC = Nothing
Set WR = Nothing
'Sheets("Clientes").Protect "123"
Sheets("Clientes").Visible = False
Sheets(nome).Activate
'-----------------------------------------------------------------------
' Parte 2
'-----------------------------------------------------------------------
' PRODUTOS MAIS VENDIDOS - Pocisionar Produto no Ranking
'-----------------------------------------------------------------------
Sheets("Ranking").Visible = True
Dim Produto As String, VendaAba As String
Dim Cont1 As Long, xb As Integer
Dim WC1 As Worksheet, WR1 As Worksheet
VendaAba = Range("B1").Value
Set WC1 = Worksheets("Ranking")
Set WR1 = Worksheets(VendaAba)
Produto = WR1.Range("F71").Value
VOLTAR:
WC1.Activate
WC1.Range("B2").Activate
Do While ActiveCell <> ""
If ActiveCell = Produto Then
ActiveCell.Offset(0, 1).Activate
Cont1 = ActiveCell
Cont1 = Cont1 + WR1.Range("G" & xb).Value '+ 1
ActiveCell = Cont1
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop
'---------------------------------------
WR1.Activate
'Aqui faz uma verificacao se existem outros produtos
For xb = 72 To 86
If Range("F" & xb).Value = "" And Range("I" & xb).Value = "" Then
GoTo Passar
Else: End If
If Range("F" & xb).Value <> "" And Range("I" & xb).Value = 0 Then
Produto = WR1.Range("F" & xb).Value
Range("I" & xb).Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo VOLTAR
End If
Next
Passar:
Set WC1 = Nothing
Set WR1 = Nothing
Sheets("Ranking").Visible = False
'-----------------------------------------------------------------------
' Parte 3
'-----------------------------------------------------------------------
' Aqui Atualiza os produtos no Estoque que foram vendidos
'-----------------------------------------------------------------------
Sheets("LANCAMENTOS ENTRADA & SAIDA").Visible = True
Sheets("Lancamentos Entrada & Saida").Unprotect "123"
Dim xy As Integer
For xy = 72 To 86
Sheets(nome).Activate
If Range("D" & xy).Value = "" Then
GoTo fim
Else: End If
If Range("D" & xy).Value <> "" Then
Sheets("Lancamentos Entrada & Saida").Activate
' Rows("3:3").Insert Shift:=xlDown - Insere uma linha inteira e joga resto pra baixo
Range("A3:E3").Insert Shift:=xlDown
Sheets(nome).Activate
Range("D" & xy & ":H" & xy).Copy
Sheets("Lancamentos Entrada & Saida").Activate 'Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next
fim:
Sheets(nome).Select
Sheets("Lancamentos Entrada & Saida").Protect "123"
Sheets("LANCAMENTOS ENTRADA & SAIDA").Visible = False
'----------------------------------------------------------------------------
' Parte 4
'----------------------------------------------------------------------------
' Grava dados na aba Vendas Feitas
'----------------------------------------------------------------------------
ActiveSheet.Calculate 'Calcula somente as fórmulas da aba ativa
Sheets("VENDAS FEITAS").Visible = True
Dim x As Integer
'--------------------------------------------------------------------------------------
' ROTINA VENDA 1, 2 ,3
'-------------------------------------------------
' PRIMEIRO PROCEDIMENTO
Dim Ws As Worksheet
Dim Dest As Range
Sheets("Vendas Feitas").Activate
Rows("5:5").Insert Shift:=xlDown
Sheets(nome).Activate
Set Ws = Sheets("Vendas Feitas") 'Referencia a guia LANÇAR COMISSAO como Ws
' Set Dest = Ws.Range("A3").Range("B50000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
Set Dest = Ws.Range("A5")
Range("AA3:AM3").Copy 'Copia o intervalo
' Dest.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
Dest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set Ws = Nothing
Set Dest = Nothing
' SEGUNDO PROCEDIMENTO
Dim Ws1 As Worksheet
Dim Dest1 As Range
' Sheets("Vendas Feitas").Activate
' Rows("6:6").Insert Shift:=xlDown
' Sheets(nome).Activate
Set Ws1 = Sheets("Vendas Feitas") 'Referencia a guia LANÇAR COMISSAO como Ws
' Set Dest1 = Ws1.Range("N3").Range("B50000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
Set Dest1 = Ws1.Range("N5")
Range("BB3:BH3").Copy 'Copia o intervalo
' Dest1.PasteSpecial xlPasteValues 'Cola valores naguia Comissão
Dest1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set Ws1 = Nothing
Set Dest1 = Nothing
For x = 4 To 17
If Range("BB" & x).Value = "" Then
GoTo Fim_Vendas
Else: End If
If Range("BB" & x).Value <> "" Then
Dim Ws2 As Worksheet
Dim Dest2 As Range
Sheets("Vendas Feitas").Activate
Rows("6:6").Insert Shift:=xlDown
Sheets(nome).Activate
Set Ws2 = Sheets("Vendas Feitas") 'Referencia a guia Mais Vendidos como Ws2
' Set Dest2 = Ws2.Range("A5").Range("B50000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
Set Dest2 = Ws2.Range("A6")
Range("AO" & x & ":BH" & x).Copy 'Copia o intervalo
' Dest2.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
Dest2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set Ws2 = Nothing
Set Dest2 = Nothing
End If
Next
Fim_Vendas:
'----------------------------------------------
'Aqui Reorganiza a numeracao dos Marcadores em Vendas Feitas
Sheets("Vendas Feitas").Activate
Range("U4").Select
Selection.Copy
Range("U5:U5000").Select
ActiveSheet.Paste
Sheets(nome).Activate
'Sheets("VENDAS FEITAS").Visible = False
'----------------------------------------------------------------------------
' Parte 5
'----------------------------------------------------------------------------
' Limpar Venda
'----------------------------------------------------------------------------
Range("B2").Value = 1
Range("B5:B33").Value = ""
Range("U6").Value = 1
Range("L15:N15").Value = ""
Range("S20").Value = ""
Range("L26:L30").Value = ""
Range("Q26:Q30").Value = ""
Range("L2").Value = 1
Range("B2").Value = ""
Range("I72:I86").Value = ""
Range("K5:K34").Value = ""
'----------------------------------------------------------------------------
' Parte 6
'----------------------------------------------------------------------------
' Gerar novo Recibo de Vendas
'----------------------------------------------------------------------------
Sheets("Venda1").Select
Sheets("Venda1").Unprotect "123"
' Gerar Recibo de vendas
t = ActiveSheet.Range("D1")
a = t + 1
Application.ActiveSheet.Range("D1").Value = a
Sheets("Venda1").Protect "123"
'Temporizador
Sheets("Tela de Finalizacao").Visible = True
Sheets("Tela de Finalizacao").Activate
'Sheets("Tela de Finalizacao").Visible = False
'Sheets(nome).Select
Application.CutCopyMode = False
Terminar:
'-------------------------------------------------------------
Application.ScreenUpdating = True
Application.DisplayAlerts = True 'desabilite o alerta
Application.DisplayStatusBar = True 'Desabilita atualização da barra de status
Application.Calculation = xlAutomatic 'Ativa modo automático de cálculo
Application.EnableEvents = True 'Ativa os eventos no Excel
ActiveSheet.DisplayPageBreaks = True 'Habilita as quebras de páginas
End Sub
Postado : 08/10/2016 7:23 am