Publicidade

slype

Funções, rotinas e dicas

Iai Amigos, blzzz...

 

Seguinte, vamos colocar aki nesse tópico algumas FUNÇÕES, ROTINAS, DICAS etc... (Algumas coisas Úteis e/ou Legais de VB)

 

Pra começar eu ja vo colocando uma rotina que uso muito em meus Projetos:

 

 

AUTO COMPLETE EM COMBOBOX:

 

1- Crie uma nova Classe de Módulo e renomeie como: clsAutoComplete

 

2- Na Classe de Módulo cole a rotina:

 

Private WithEvents pCombo As ComboBoxPrivate IsDelOrBack As BooleanPublic Sub Bind(Cmb As ComboBox)Set pCombo = CmbEnd SubPrivate Sub Class_Terminate()Set pCombo = NothingEnd SubPrivate Sub pCombo_Change()On Error Resume NextDim OldLen As IntegerDim i As IntegerIf Not pCombo.Text = "" And Not IsDelOrBack Then	OldLen = Len(pCombo.Text)	For i = 0 To pCombo.ListCount - 1		If InStr(1, Mid$(UCase(pCombo.List(i)), 1, OldLen), UCase(pCombo.Text)) Then			pCombo.Text = pCombo.List(i)			If pCombo.SelText = "" Then				pCombo.SelStart = OldLen			Else				pCombo.SelStart = InStr(pCombo.Text, pCombo.SelText)			End If			pCombo.SelLength = Len(pCombo.Text)			Exit For		End If	NextEnd IfEnd SubPrivate Sub pCombo_KeyDown(KeyCode As Integer, Shift As Integer)IsDelOrBack = (KeyCode = vbKeyBack Or KeyCode = vbKeyDelete)End Sub
3- No Form que for usar o Auto Complete declare a Classe de Módulo:

 

Dim Complete As New clsAutoComplete
4- E por fim, chame a Rotina no seu ComboBox:

 

Complete.Bind cboNome
* Onde cboNome é o nome do seu ComboBox.

 

Obs: Use o comando acima para chamar a rotina depois de ter Enchido ele ou no LOAD do Form.

 

É isso ae, Postem as suas agora.... até

0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Pode ser que muitos saibam dessas discas de uso, mais vou cita-las, são bem uteis:1- Quando estiver digitando um comando, utilize (CTRL + ESPAÇO), o VB te mostra todos os comando que você pode estar utilizando nessa linha.2- Quando desejar procurar uma propriedade de um Objeto, ao invez ficar rolando a barra com o mouse, aperte: CHIFT + CTRL + (a primeira letra da propriedade.Exemplo, você quer a propriedade "TEXT" = CHIFT + CTRL + T3 - Ao ver uma chamada de Função, Sub ou Variavel, para ir até a definição dela basta clicar com 'botão direito' no nome > 'Definition'4 - Para movimentar objetos de um Form com teclado: Segure CTRL e mova com as setas do teclado5 - Para redimensionar objetos de um Form com teclado: Segure SHIFT e redimensione com as setas do teclado...é isso ae Galera.... Em breve posto mais, continuem postando, Até mais!

1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Função pra validar um e-mail

 

 

Public Function EmailOK(ByVal Email As String) As Boolean	Dim j As Long, C As String	If Email = "" Or Email Like "*@*" And _	(Email Like "*.??" Or Email Like "*.???") _	Then EmailOK = True	If Email Like "*.???" Then		C = Right$(Email, 4)		If C = ".com" Or C = ".net" Or C = ".edu" _		Or C = ".mil" Or C = ".gov" Or C = ".org" Then	Else		EmailOK = False	End IfEnd IfFor j = 1 To Len(Email)	C = Mid$(Email, j, 1)	If C = "@" Or C = "." Or C = "-" Or C = "_" _	Or C >= Chr(48) And C <= Chr(57) _	Or LCase(C) >= Chr(97) And _	LCase(C) <= Chr(122) ThenElse	EmailOK = FalseEnd IfNext jEnd Function

Pra chamar a função:

 

If EMailOK(seuemail.text)= true then  Msgbox "E-mail válido"Else  Msgbox "E-mail inválido"End If
0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Uma SUBzinha bastante Util que eu mesmo Criei...

 

Função: Escrever direto em uma MSFlexGrid

 

Vamos Lá....

 

Cole em um Módulo:

Public Sub EscreveNaGrid(Grid As MSFlexGrid, Coluna As Integer, Linha As Integer, Key As Integer, SóNumero As Boolean)'Sub Criada por Slype - 20/02/2006	On Error Resume Next	If Key = 8 Then		Grid.TextMatrix(Linha, Coluna) = Left(Grid.TextMatrix(Linha, Coluna), Len(Grid.TextMatrix(Linha, Coluna)) - 1)	ElseIf Key = 13 Then		Grid.Row = Grid.Row + 1	Else		If SóNumero = True Then			If Not IsNumeric(Chr(Key)) And Key <> 44 Then Exit Sub		End If		Grid.TextMatrix(Linha, Coluna) = Grid.TextMatrix(Linha, Coluna) & Chr(Key)	End IfEnd Sub

Chame a função no Evento KeyPress do seu MSFlexGrid:

Private Sub NomeDoGrid_KeyPress(KeyAscii As Integer)	EscreveNaGrid NomeDoGrid, NomeDoGrid.Col, NomeDoGrid.Row, KeyAscii, FalseEnd Sub

... Caso queira que seje digitado Somente Numeros Então chame assim:

Private Sub NomeDoGrid_KeyPress(KeyAscii As Integer)	EscreveNaGrid NomeDoGrid, NomeDoGrid.Col, NomeDoGrid.Row, KeyAscii, TrueEnd Sub

É isso ai... Espero que Seje Util á Voces!!!

falowww ate mais!!!

0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Trocar Tab por Enter

 

se precisar usar em varios campos coloque no keypress do formulario

e deixe o KeyPreview do formulário para True

 

  If KeyAscii = 13 Then  SendKeys "{tab}"

 

para evitar um beep deixe o keyascii com valor 0 :

 

  If KeyAscii = 13 Then
  SendKeys "{tab}"
  KeyAscii = 0
 End If

 

Permitir só numeros no campo text

 

coloque no KeyPress do campo text

 

KeyAscii = IIf(KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8, KeyAscii, 0)

 

Exibir a data atual no padrao dd/mm/yyyy

 

só usar o format()

Format(Date, "dd/mm/yyyy")

 

Ultimo dia do mes:

Format(DateSerial(Year(Now), Month(Now) + 1, 0), "dd/mm/yyyy")

 

Deixar o campo text somente com letras maiusculas:

 

KeyAscii = Asc(UCase(Chr(KeyAscii)))

obs: para forçar somente minusculas use a função LCase no lugar da UCase

 

Função que preenche com zeros a esquerda ou direita do numero

 

coloque num modulo a função abaixo:

Public Function FormataZero_Esquerda(Valor As String, Casas As String)
FormataZero_Esquerda = Left(Casas, Len(Casas) - Len(Valor)) & Valor
End Function

 

modo de usar :

msgbox FormataZero_Esquerda("12", "00000")

 

obs: para preencher com zeros a direita só inverter "Valor" na função colocando ele na frente

e pode preencher com outro caracter sem ser zero

0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Conexao Com banco de Dados MySQL usando Dll nativa "libmySQL", sem usar ODBC ou Drivers

 

basta Referenciar a MyVbQL.dll

 

e usar assim:

 

Dim my As MYSQL_CONNECTION
Set my = New MYSQL_CONNECTION

my.OpenConnection "localhost", "usuario", "senha", "banco"

If my.State = MY_CONN_OPEN Then
	MsgBox "successo"
Else
	MsgBox "Falha na conexao"
End If

Set MyRS = my.Execute("select * from tabela")

alguns metodos:

MsgBox MyRS.RecordCount
MsgBox MyRS.FieldCount
MsgBox MyRS.Fields(0).Name

 

procurem essa dll no google é facil de achar mas quem nao conseguir posta ai que eu envio a dll por email

 

e ela tem muitos outros recursos apenas mostrei como conectar

 

existe tbm MyOLEDB.exe para conectar usando Provider mas nao gostei muito prefiro a MyVbQL

 

qualquer duvida só postar

1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Calcular idade:

 

Int(DateDiff("y", CDate(data_niver), Date) / 365.25)

0

Compartilhar este post


Link para o post
Compartilhar em outros sites

• Função para Encher um ComboBox com Dados de um Campo de uma Tabela (em ADO)

 

Função:

Public Function DadosCBOtabela(Cb As ComboBox, Tabela As String, Campo As String) As Boolean	Dim Seleção as ADODB.Recordset	StrTemp = Cb.Text	Cb.Clear	Set Seleção = New ADODB.Recordset		Seleção.Open "SELECT " & Campo & " FROM " & Tabela & " ORDER BY " & Campo, BDdados, adOpenDynamic, adLockReadOnly	If Seleção.EOF = True Then		DadosCBOtabela = False		Seleção.Close		Exit Function	End If	Do While Not Seleção.EOF		Cb.AddItem IIf(IsNull(Seleção(Campo)), "", Seleção(Campo))		Seleção.MoveNext	Loop	DadosCBOtabela = True	Seleção.Close	Cb.Text = StrTemp	StrTemp = ""End Function
*Onde BDdados é uma connexão ADO com um Banco....

 

Ex de uma connexão ADO com BD Access:

Dim BDdados as ADODB.Connection	Set BDdados = New ADODB.Connection	BDdados.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=SENHA;" & "Data Source=C:\Dados.mdb;" & "Persist Security Info=False"	BDdados.Open
Como chamar a Função:

DadosCBOtabela Cbo_Nome, "Clientes", "Nome"
...é isso ae galera.....Taí mais uma funçãozinha show de bola!!! =]

Até mais!!!

0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Função muito util na hora de criar uma pasta:

 

Caso voce queira criar a pasta "c:\func\vb\imasters" e não existe nenhuma dessas pastas, nem a func, ao inves de criar uma por uma usando o MKDIR, jogue esse caminho nessa funcao:

 

Public Function NewPath(path As String) As StringDim QuebraPasta As VariantDim CriaPasta As StringDim cont As IntegerDim QuebraParametro As VariantOn Error GoTo trataIf Right(path, 1) = "\" Then path = Left(path, Len(path) - 1)If FileExist(path) = False Then	QuebraPasta = Split(path, "\")	For cont = 1 To UBound(QuebraPasta)		If cont = UBound(QuebraPasta) Then			QuebraParametro = Split(QuebraPasta(cont), ";")			If cont = 1 Then				CriaPasta = QuebraPasta(0) & "\" & QuebraParametro(0)			Else				CriaPasta = CriaPasta & "\" & QuebraParametro(0)			End If		Else			If CriaPasta = "" Then				CriaPasta = QuebraPasta(cont - 1) & "\" & QuebraPasta(cont)			Else				CriaPasta = CriaPasta & "\" & QuebraPasta(cont)			End If		End If		If Not FileExist(CriaPasta) Then MkDir (CriaPasta)	Next contEnd Iftrata:If Err.Number = 76 Or Err.Number = 75 Then	Resume NextElseIf Err.Number <> 0 Then	MsgBox Err.Number & " - " & Err.Description, vbCriticalEnd IfEnd Function
0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Tai mais uma de minhas Subs...

essa é show de bola, quebra um galhão nos meus sistemas...

 

• Serve para carregar um ComboBox com Informações (baseado no parametro (Tipo) que você passa)

• Vcs podem colocar mais coisas nela... é só seguir o eskema:

 

Public Sub DadosCBO(Cb As ComboBox, Tipo As String, Optional NumIni As Double, Optional NumFim As Double)	Cb.Clear	Tipo = LCase(Tipo)	Select Case Tipo		Case "meses"			Cb.AddItem "Janeiro"			Cb.AddItem "Fevereiro"			Cb.AddItem "Março"			Cb.AddItem "Abril"			Cb.AddItem "Maio"			Cb.AddItem "Junho"			Cb.AddItem "Julho"			Cb.AddItem "Agosto"			Cb.AddItem "Setembro"			Cb.AddItem "Outubro"			Cb.AddItem "Novembro"			Cb.AddItem "Dezembro"		Case "diasemana"			Cb.AddItem "Domingo"			Cb.AddItem "Segunda"			Cb.AddItem "Terça"			Cb.AddItem "Quarta"			Cb.AddItem "Quinta"			Cb.AddItem "Sexta"			Cb.AddItem "Sábado"		Case "numeros"			Do While NumIni <= NumFim				Cb.AddItem NumIni				NumIni = NumIni + 1			Loop		Case "estados"			Cb.AddItem "AC"			Cb.AddItem "AL"			Cb.AddItem "AM"			Cb.AddItem "AP"			Cb.AddItem "BA"			Cb.AddItem "CE"			Cb.AddItem "DF"			Cb.AddItem "ES"			Cb.AddItem "GO"			Cb.AddItem "MA"			Cb.AddItem "MG"			Cb.AddItem "MS"			Cb.AddItem "MT"			Cb.AddItem "PA"			Cb.AddItem "PB"			Cb.AddItem "PE"			Cb.AddItem "PI"			Cb.AddItem "PR"			Cb.AddItem "RJ"			Cb.AddItem "RN"			Cb.AddItem "RO"			Cb.AddItem "RR"			Cb.AddItem "RS"			Cb.AddItem "SC"			Cb.AddItem "SE"			Cb.AddItem "SP"			Cb.AddItem "TO"		Case "impressoras"			For Each ImprComputador In Printers				Cb.AddItem ImprComputador.DeviceName			Next ImprComputador		Case "estadocivil"			Cb.AddItem "Amasiado(a)"			Cb.AddItem "Casado(a)"			Cb.AddItem "Desquitado(a)"			Cb.AddItem "Divorciado(a)"			Cb.AddItem "Separado(a)"			Cb.AddItem "Solteiro(a)"			Cb.AddItem "Viúvo(a)"			Cb.AddItem "2º União"		Case "sexo"			Cb.AddItem "Masculino"			Cb.AddItem "Feminino"	End SelectEnd Sub

... show de bola pessoal... continuem postando!!! Até mais!

0

Compartilhar este post


Link para o post
Compartilhar em outros sites
Informar a data ex:Dim as dhoje as stringdhohe = RetDia(11/03/2007)Retorno = Domingo, 11 de Março de 2007Public Function RetDia(qData As Date) As String			  Dim Dia(), Mes(), lngValor As Integer			  Dia = Array("Domingo", "Segunda-Feira", "Terça-Feira", "Quarta-Feira", "Quinta-Feira", "Sexta-Feira", "Sábado")			  lngValor = Weekday(qData)			  Mes = Array("Janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", _			  "Julho", "Agosto", "Setembro", "Outubro", "Novembro", "Dezembro")			  RetDia = Dia(lngValor) + ", " + CStr(Day(qData)) + " de " + Mes(Month(qData)) + " de " + CStr(Year(qData))End Function
0

Compartilhar este post


Link para o post
Compartilhar em outros sites
Algumas vezes precisamos realizar checks, comparações etc.Abaixo crieI uma função que me retorna se pode ou não digitar uma informação.No exemplo abaixo verifico se um lançamento de horas é valido ou não. ( Uso horas no formato texto 00:00 a 23:59 convertidos em minutos de 0 a 1439 )No form da digitação deixo um listbox invisivel, onde a função abaixo preenche com os parâmetros enviados.List1 = listboxtE1 = por exemplo : 720 , ou seja 12:00 * 60 minutos.tS2 = por exemplo : 1080 , ou seja 18:00 * 60 minutos.val(TxtAte.text) = o valor digitado.Será carregado no listbox os valores entre 720 a 1080'------------------------------------------------------------------------------------------------------------If ChekHorasDigitadas(List1, tE1, tS2, val(TxtAte.text)) = "S" Then   msgbox "Localizado"  'Ok permitidoendif'------------------------------------------------------------------------------------------------------------Public Function ChekHorasDigitadas(ListaResu As ListBox, HTabini, HTabfim, HDigit)	Dim a As Integer, f As Integer, I As Integer	Dim xHoraLocalizada As Integer	Dim Hinicial As Integer	Dim Hfinal As Integer			Hinicial = HTabini	Hfinal = HTabfim		If Hfinal < Hinicial Then		Hfinal = Hfinal + 1440	End If		ListaResu.Clear	For a = Hinicial To Hfinal		If a < 1440 Then		   ListaResu.AddItem a		End If		If a = 1440 Then		   Hinicial = 0		   Hfinal = Hfinal - 1440		   For f = Hinicial To Hfinal			   ListaResu.AddItem f		   Next		End If	Next		For I = 0 To ListaResu.ListCount - 1		xHoraLocalizada = ListaResu.List(I)		If xHoraLocalizada = HDigit Then		   ChekHorasDigitadas = "S"		   Exit Function		Else		   ChekHorasDigitadas = "N"		End If	Next	End Function'------------------------------------------------------------------------------------------------------------Utilizando a mesma lógica você pode usar a função com poucas modificação para fazer outras verificações, por exemplo :Verificação de UF, Cidades, Numeros sequenciais ou não, e outros conforme sua imaginação.Poderia tambem ser realizado ao invés de usar o ListBox, poderia ser usado uma Matrix(x), mas preferi dessa forma, visto que confiro todos os resultados no ato no listbox)tenha o cuidado de não permitir o estouro do listbox ou a performance, caso o conteudo temporários do listbox seja muito extensa.
0

Compartilhar este post


Link para o post
Compartilhar em outros sites

fazer um form ficar na frente de todos, sem permitir que acesse outro form no aplicativo, tipo um msgbox!

 

exemplo:

 

'NO ENVENTO EM QUE você VAI CHAMAR O FORMPrivate sub Command1_Click()form1.show 1end sub
0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Aê galera, beleza?

Não sei se será útil para alguém, mas eu precisei dessa coisa e num achei em lugar nenhum. Então, depois de feito, é hora de compartilhar...

 

Justificar parágrafo em VB com objeto PRINTER

 

Você vai precisar de um arquivo de módulo. No meu caso, chamei-o de modPrinter.bas

 

Public Const PHYSICALHEIGHT = 111
Public Const PHYSICALWIDTH = 110
Public Const PHYSICALOFFSETX = 112
Public Const PHYSICALOFFSETY = 113

Public Type SIZE
    cx As Long
    cy As Long
End Type

Public Declare Function _
    GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _
        ByVal hdc As Long, _
        ByVal lpsz As String, _
        ByVal cbString As Long, _
        lpSize As SIZE _
) As Long

Public Declare Function _
    SetTextJustification Lib "gdi32" ( _
        ByVal hdc As Long, _
        ByVal nBreakExtra As Long, _
        ByVal nBreakCount As Long _
) As Long

Public Declare Function _
    TextOut Lib "gdi32" Alias "TextOutA" ( _
        ByVal hdc As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal lpString As String, _
        ByVal nCount As Long _
) As Long

Public Declare Function _
    GetDeviceCaps Lib "gdi32" ( _
        ByVal hdc As Long, _
        ByVal nIndex As Long _
) As Long

E aqui vai o arquivo de classe, que chamei de CPrinter.cls

 

Option Explicit

Private m_hDC As Double
Private m_LeftMargin As Long
Private m_RightMargin As Long
Private m_LineSize As Long
Private m_LineHeight As Long


Private Function getLineSpaces(ByVal szText As String) As Long
    getLineSpaces = UBound(Split(szText, " "))
End Function


Public Property Let hdc(ByVal lngParm As Double)
    m_hDC = lngParm
End Property
Public Property Get hdc() As Double
    hdc = m_hDC
End Property


'Selectiona a impressora desejada pelo nome. Retorna o nome da impressora anteriormente selecionada
Public Function setPrinterDevice(ByVal szDeviceName) As String
    Dim sz As SIZE
    Dim lPtr As Printer
    setPrinterDevice = Printer.DeviceName
    Printer.KillDoc
    If (szDeviceName <> "") Then
        For Each lPtr In Printers
            If (lPtr.DeviceName = szDeviceName) Then
                Set Printer = lPtr
                Exit For
            End If
        Next
    End If
    m_hDC = Printer.hdc
    m_LeftMargin = GetDeviceCaps(m_hDC, PHYSICALOFFSETX)
    m_RightMargin = GetDeviceCaps(m_hDC, PHYSICALWIDTH) - (GetDeviceCaps(m_hDC, PHYSICALOFFSETX) * 2)
    m_LineSize = m_RightMargin - m_LeftMargin
    
    GetTextExtentPoint32 m_hDC, "X", 1, sz
    m_LineHeight = sz.cy
    
    Printer.Print
End Function


Public Function PrintText(ByVal szText As String)
    Dim sz As SIZE
    Dim iPos As Long
    Dim iOldPos As Long
    Dim szBuffer As String
    
    Do While (szText <> "")
        iPos = 0
        szBuffer$ = ""
        sz.cx = 0: sz.cy = 0
        Do While (sz.cx <= m_LineSize And iPos < Len(szText) And iPos <> -1)
            iOldPos = iPos
            iPos = InStr(iPos + 1, szText, " ")
            If (iPos = 0) Then
                szBuffer$ = szText$
                iPos = -1
            Else
                szBuffer$ = Left(szText$, iPos - 1)
            End If
            GetTextExtentPoint32 m_hDC, szBuffer$, Len(szBuffer$), sz
        Loop
        If (iPos = -1) Then
            szBuffer$ = szText$
            szText$ = ""
        Else
            szBuffer$ = Left$(szText$, iOldPos - 1)
            szText$ = Mid$(szText$, iOldPos + 1)
        End If
    
        If (iPos <> -1) Then
            GetTextExtentPoint32 m_hDC, szBuffer$, Len(szBuffer$), sz
            SetTextJustification m_hDC, m_LineSize - sz.cx, getLineSpaces(szBuffer$)
        Else
            SetTextJustification m_hDC, 0, 0
        End If
        TextOut m_hDC, 0, Printer.CurrentY, szBuffer$, Len(szBuffer$)
        SetTextJustification m_hDC, 0, 0
        Printer.CurrentY = Printer.CurrentY + sz.cy
    Loop
End Function

Public Sub newLine(Optional ByVal intLines As Integer = 1)
    Printer.CurrentX = 0
    Printer.CurrentY = Printer.CurrentY + (m_LineHeight * intLines)
End Sub

Public Sub EndDoc()
    Printer.EndDoc
End Sub

E agora, um exemplo de utilização. Crie um form e coloque um botão no mesmo. No evento de click do botão, coloque algo como isto:

 

Private Sub Command2_Click()
    Dim oPtr As New CPrinter
    Dim szBuffer As String
    
    'Seleciona a impressora desejada
    oPtr.setPrinterDevice "" 'Sem informar nada, assume a impressora padrão configurada
    
    szBuffer = "Coloque qualquer texto aqui. A função PrintText quebra as linhas e justifica para você"
    oPtr.PrintText szBuffer$
    
    'A função newLine salta um determinado número de linhas. Quando não for informado o número, assume o padrão de saltar 1 linha.
    'IMPORTANTE: A função PrintText já salta para a próxima linha. Utilize newLine apenas para saltar mais linhas

    oPtr.newLine     'Salta 1 linha
    oPtr.newLine 1  'Salta 1 linha
    oPtr.newLine 5  'Salta 5 linhas
    
    szBuffer$ = "Coloque qualquer outro texto aqui"
    oPtr.PrintText szBuffer$
    
    Printer.EndDoc 'Finaliza impressão e despeja para a impressora
End Sub

É isso aê... espero ter ajudado alguém. Funcionou direitinho em uma HP DeskJet, em uma HP Laserjet e jogando para PDF via Easy PDF Creator.

Abs,

Roney

Editado por Claudio Neto
Trocadas tags <div> por [code] para deixar padronizado
0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Função Salvar "igual" do Notepad, Word, etc...

 

Crie uma váriavel(FormAlterado)para todo o form.

 

No load do form você coloca FormAlterado = False.

 

Nos eventos CHANGE dos seus textbox, combobox, e mais o que você tiver na tela, você coloca FormAlterado = True

 

Daí no evento QueryUnload do Form você verificaessa variavel.

Ficará assim:

 

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Dim mensagem As String, botões As Integer, titulo As String
Dim resposta As Integer
   mensagem = "Deseja salvar as alterações ?"   ' Define mensagem
   botões = vbYesNoCancel + vbExclamation ' Define  botões
   titulo = "Cadastro de Clientes"   ' Define título
      resposta = MsgBox(mensagem, botões, titulo)
   If resposta = vbNo Then   'se a resposta foi "não"
      Unload Me
   ElseIf resposta = vbYes Then  'se a resposta foi "sim"
     cmdSalvar_Click
   Else
  Cancel = 1 'se a resposta foi "cancelar"
   End If
       
End Sub

Pra mim foi útil pode ser pra vocês tmb...

Abraço!

0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ordenando DataGrid no Visual Basic 6.

 

Como faremos isso?

Primeiro, usaremos o evento HEADCLICK do DataGrid.

Segundo, usaremos a propriedade sort do recordset para sortear a coluna em questão selecionada pelo usuário.

 

Veja exemplo:

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer) 
    adodc1.recordset.sort=adodc1.recordset.fields(colindex).name 
End Sub

Grato,

Giancarlo Braga

0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Função para Marcar/desmarcar todos os filhos em uma treeview.

 

TV = minha treeview

Configure a treeview para usar checkbox

 

No evento NodeCheck:

Private Sub TV_NodeCheck(ByVal Node As MSComctlLib.Node)
   If Node.Children > 0 Then
      SelecionarFilhos Node.Key, Node.Checked
   End If
end sub

Função:

Private Sub SelecionarFilhos(nKey As String, Check As Boolean)
   For I = 1 To TV.Nodes.Count
      Set Nx = TV.Nodes.Item(I)
      If Nx.Tag <> "PAI" Then 'quando criei a treeview identifiquei com a Tag = Pai o primeiro nível'
         If Nx.Parent.Key = nKey Then
            Nx.Checked = Check
         End If
      End If
   Next I
   For I = 1 To TV.Nodes.Count
      Set Nx = TV.Nodes.Item(I)
      If Nx.Tag <> "PAI" Then
         If Nx.Children > 0 And Nx.Checked = Check And Nx.Parent.Key = nKey Then
            Nx.Expanded = True
            SelecionarFilhos Nx.Key, Check
         End If
      End If
   Next I
End Sub
0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Tai mais uma de minhas Subs...

essa é show de bola, quebra um galhão nos meus sistemas...

 

• Serve para carregar um ComboBox com Informações (baseado no parametro (Tipo) que você passa)

• Vcs podem colocar mais coisas nela... é só seguir o eskema:

 

Public Sub DadosCBO(Cb As ComboBox, Tipo As String, Optional NumIni As Double, Optional NumFim As Double)
Cb.Clear
Tipo = LCase(Tipo)
Select Case Tipo
	Case "meses"
		Cb.AddItem "Janeiro"
		Cb.AddItem "Fevereiro"
		Cb.AddItem "Março"
		Cb.AddItem "Abril"
		Cb.AddItem "Maio"
		Cb.AddItem "Junho"
		Cb.AddItem "Julho"
		Cb.AddItem "Agosto"
		Cb.AddItem "Setembro"
		Cb.AddItem "Outubro"
		Cb.AddItem "Novembro"
		Cb.AddItem "Dezembro"
	Case "diasemana"
		Cb.AddItem "Domingo"
		Cb.AddItem "Segunda"
		Cb.AddItem "Terça"
		Cb.AddItem "Quarta"
		Cb.AddItem "Quinta"
		Cb.AddItem "Sexta"
		Cb.AddItem "Sábado"
	Case "numeros"
		Do While NumIni <= NumFim
			Cb.AddItem NumIni
			NumIni = NumIni + 1
		Loop
	Case "estados"
		Cb.AddItem "AC"
		Cb.AddItem "AL"
		Cb.AddItem "AM"
		Cb.AddItem "AP"
		Cb.AddItem "BA"
		Cb.AddItem "CE"
		Cb.AddItem "DF"
		Cb.AddItem "ES"
		Cb.AddItem "GO"
		Cb.AddItem "MA"
		Cb.AddItem "MG"
		Cb.AddItem "MS"
		Cb.AddItem "MT"
		Cb.AddItem "PA"
		Cb.AddItem "PB"
		Cb.AddItem "PE"
		Cb.AddItem "PI"
		Cb.AddItem "PR"
		Cb.AddItem "RJ"
		Cb.AddItem "RN"
		Cb.AddItem "RO"
		Cb.AddItem "RR"
		Cb.AddItem "RS"
		Cb.AddItem "SC"
		Cb.AddItem "SE"
		Cb.AddItem "SP"
		Cb.AddItem "TO"
	Case "impressoras"
		For Each ImprComputador In Printers
			Cb.AddItem ImprComputador.DeviceName
		Next ImprComputador
	Case "estadocivil"
		Cb.AddItem "Amasiado(a)"
		Cb.AddItem "Casado(a)"
		Cb.AddItem "Desquitado(a)"
		Cb.AddItem "Divorciado(a)"
		Cb.AddItem "Separado(a)"
		Cb.AddItem "Solteiro(a)"
		Cb.AddItem "Viúvo(a)"
		Cb.AddItem "2º União"
	Case "sexo"
		Cb.AddItem "Masculino"
		Cb.AddItem "Feminino"
End Select
End Sub

 

... show de bola pessoal... continuem postando!!! Até mais!

 

 

 

Caro amigo: Amasiado, desquitado e 2ª união não são "estado civil" brasileiro pelo código civil em vigência.

0

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!


Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.


Entrar Agora