jeanvet

bem legal as ideias das bandeiras, acho que vou usar, pena que a impressora não imprime colorido, e o outro problema é que o valor minimo e máximo estão na mesma celula, 

e o problema eu resolvi sozinho, como vem acontecendo

mas fica o que eu usei, vai que ajuda agluém

If Worksheets("backup").Cells(SpinButtonArquivo.Value + 1, 3).Value = ("canino") Then
ObCanino.Value = True
Else
ObFelino.Value = True
End If

tenho um formulário de cadastro que envia informações para o banco de dados onde cada cadastro gera uma numeração automática seguida dos valores preenchidos

adicionei no formulário um spinbutton, botão de rolagem, e o valor dele é igual ao numero do ultimo cadastro, então toda vez que clico no botao < do spin é carregado em todos os campos os ultimos dados preenchidos, e assim sucessivamente.

o problema é que não estou conseguindo carregar as infações preenchidas anteriormente quando o conteudo foi fornecido via botão de opção. ou seja, tenho no formulário uma das duas opções para escolher, macho ou fêmea, quando se clica em macho e clica em salva, para o backup vai a informação macho.

para todas os campos que não são botão de opção, o resgate funciona da seguinte forma:

ComboBox1 = ws.Cells(SpinButtonArquivo.Value + 1, 4).Value

e para os botões de opção sexo (macho;femea) e especie (canino, felino) tento com esse código mas não está funcionando.

Dim linha As String
linha = SpinButtonArquivo.Value + 1
If Worksheets("backup").Cells(linha, 6).Value = Macho Then
OBMasculino.Value = True
Else
ObFeminino.Value = False
End If

alguém pode me dar uma solução? desde já agradeço

planilha em anexo

Preencher Hemograma V4.9.3.xlsm

já que ninguém ajudou, eu resolvi o problema primeiro atribuindo um valor ao botão de rolagem, esse valor era a contagem do numero de celulas preenchidas no banco de dados + 1 com o seguinte código:

Private Sub UserForm_Initialize()

'spin button arquivo
    Dim iRow As Long
    Dim pt As Worksheet
    Set pt = Worksheets("backup")

    iRow = pt.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row

    SpinButtonArquivo.Value = iRow
    
    TBspinbutton.Value = SpinButtonArquivo.Value
    
 End Sub

definido onde comesará a contagem, basta configurar o que vai acontecer quando clicar no botão voltar do botão de rolagem:

Private Sub SpinButtonArquivo_Change()

TBspinbutton = SpinButtonArquivo.Value

    Dim ws As Worksheet
    Set ws = Worksheets("backup")

 

TextBoxpaciente = ws.Cells(SpinButtonArquivo.Value + 1, 2).Value
TextBoxidade = ws.Cells(SpinButtonArquivo.Value + 1, 5).Value
TextBoxproprietario = ws.Cells(SpinButtonArquivo.Value + 1, 7).Value
TextBoxdata = ws.Cells(SpinButtonArquivo.Value + 1, 9).Value
TextBoxeritrocitos = ws.Cells(SpinButtonArquivo.Value + 1, 10).Value
tbhemoglobina = ws.Cells(SpinButtonArquivo.Value + 1, 11).Value
tbhematocrito = ws.Cells(SpinButtonArquivo.Value + 1, 12).Value
tbplaquetas = ws.Cells(SpinButtonArquivo.Value + 1, 13).Value
tbalt = ws.Cells(SpinButtonArquivo.Value + 1, 14).Value
TBfa = ws.Cells(SpinButtonArquivo.Value + 1, 15).Value
tbcreatinina = ws.Cells(SpinButtonArquivo.Value + 1, 16).Value
TBureia = ws.Cells(SpinButtonArquivo.Value + 1, 17).Value
tbleucototais = ws.Cells(SpinButtonArquivo.Value + 1, 18).Value
tbeosinofilos = ws.Cells(SpinButtonArquivo.Value + 1, 19).Value
tblinfocitos = ws.Cells(SpinButtonArquivo.Value + 1, 20).Value
TBglicemia = ws.Cells(SpinButtonArquivo.Value + 1, 21).Value
ComboBox1 = ws.Cells(SpinButtonArquivo.Value + 1, 4).Value
CbVeterinario = ws.Cells(SpinButtonArquivo.Value + 1, 8).Value

Dim linha As String
linha = SpinButtonArquivo.Value + 1
If Worksheets("backup").Cells(linha, 6).Value = Macho Then
OBMasculino.Value = True
Else
ObFeminino.Value = False
End If

BotaoMostraEscondeBioquimicos = True


End Sub

então coloquei o valor do spinbutton como sendo referente a linha, então bastando variar a coluna do valor referente no banco de dados.

graças ao forum a função principal do meu formulário já está pronta, só que eu criei um botão de rolagem no formulário e gostaria de carregar os dados preenchidos anteriormente no próprio formulário de acordo que vai retornando ou avançando no botão de rolagem. vai em anexo a versão final

Preencher Hemograma V4.6beta.xlsm

funcionou. obrigado *-* graças a voce meu projeto está quase pronto.

amigo @CasaDoHardware, muito obrigado, você me ajuda muito. consegui aplicar nos outros botões menos no de glicemia, pois quero manter ela por padrão desativada, então só está funcionando se eu ativo ela e depois desativo a caixa, se acaba de entrar e ela está desmarcada, continua sendo possível adicionar texto nela. 

Preencher Hemograma V4.6.1beta.xlsm

ola, no meu formulário estou tentando bloquear alguns campos caso a pessoa desmarque a caixa de seleção ao lado da txtbox, ficaria assim:

[  ] caixa de texto bloqueada, não é possível escrever 

[x] caixa de texto desbloqueada, pode inserir texto

atualmente estou tentando o atual código mas não funcionou

Private Sub UserForm_Initialize()
TBdata = Date
'If Me.ObCanino = True Then
'ComboBox1.RowSource = "Veterinarios"
'End If
CbVeterinario.RowSource = "Veterinarios"

If Me.CheckALT = True Then
    tbalt.Locked = False
ElseIf Me.CheckALT = True Then
    tbalt.Locked = True
End If

If Me.CheckFosfatase = True Then
    tbgpt.Locked = False
ElseIf Me.CheckFosfatase = True Then
    tbgpt.Locked = True
End If

If Me.CheckCreatinina = True Then
    tbcreatinina.Locked = False
ElseIf Me.CheckCreatinina = True Then
    tbcreatinina.Locked = True
End If

If Me.CheckUreia = True Then
    tbureia.Locked = False
ElseIf Me.CheckUreia = True Then
    tbureia.Locked = True
End If

If Me.CheckGlicemia = True Then
    tbglicemia.Locked = False
ElseIf Me.CheckGlicemia = True Then
    tbglicemia.Locked = True
End If

agradeço maisessa ajuda. 

Preencher Hemograma V4.6beta.xlsm

oi, tem esse site aqui que ensina um passo a passo de como fazer uma, do inicio ao fim, se precisar de ajuda pode contar comigo

http://juliobattisti.com.br/tutoriais/ericogoncalves/bibliotecaescolar001.asp

exatamente. obrigado amigo, vou pesquisar sobre intervalos nomeados. muito obrigado

obrigado cara, funcionou, mas não consegui aplicar aos outros combo box do form.

ola, estou com um formulário em vba e ja tentei todos os codigos que encontrei na internet para carregar os dados na combo box raças mas nada funciona, não sei o que está acontecendo.

alguém tem alguma ideia do que pode ser?

o arquivo vai em anexo

Preencher Hemograma V4.5beta.xlsm

consegui resolver parte do proposito usando esse video, agora falta outra parte, tópico encerrado.

vou deixar o codigo para caso alguem chegue aqui pelo google

    Sheets("backup").Select
    Rows("1:3").Select
    Selection.EntireRow.Hidden = False
    Range("A2:T2").Select
    Selection.Copy
    Range("A3:T3").Select
    Range("T3").Activate
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[1]C+1"
    Rows("2:2").Select
    Selection.EntireRow.Hidden = True
    Sheets("PREENCHER").Select

oi, me desculpa, era isso que eu estava fazendo agora, aqui está@Basole

Preencher Hemograma V2.8.xlsm

@Basole os dados da aba "preencher" eles já são usados para gerar os dados para alimentar o modelo da aba "exames" e eu gostaria de usar os dados da aba "preencher" e enviar para algum lugar para poder recuperalos clicando em um botão 

Olá novamente, com a ajuda do pessoal do fórum minha planilha que captura dados em um formulario e joga em um modelo e salva em pdf está pronto, agora o que eu não estou conseguindo fazer é criar uma especie de botão voltar e avançar, quando clicar em salvar, além de gerar o arquivo pdf igual já faz, também salva esses registros em um banco de dados, e quando clicar no botão voltar, carrega o ultimo exame salvo, se clicar em voltar novamente carrega o penultimo, e assim por diante. 

em anexo vai minha planilha pronta para vocês verem, para funcionar precisa mudar a macro salvar e trocar o caminho onde salvar.

o botão salvar atualmente está assim

Sub salvar()
'
' salvar Macro
'
Application.ScreenUpdating = False
Dim nome As String
Dim k As Integer
Dim fName As String

With Sheets("Preencher")
If .Range("E5") = "" Or .Range("k7") = "" Then MsgBox "Preencha todos os dados": Exit Sub

nome = "C:\Users\Animed\Desktop\EXAMES PDF\" & .Range("E5") & " - " & .Range("k7") & ".pdf"

If Len(Dir(nome, vbNormal)) = 0 Then
      GoTo Fin
      Else
         fName = nome
         Do Until Len(Dir(nome, vbNormal)) = 0
            k = k + 1
            nome = VBA.Replace(VBA.UCase(fName), ".PDF", "(" & k & ").PDF")
            Loop
Fin:
    Sheets("Exame").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nome, Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    Sheets("PREENCHER").Select
    Range("E5:G5").Select
    End If
    End With
    
Application.ScreenUpdating = True
End Sub

Preencher Hemograma V2.8.xlsm

Cara... funcionou perfeitamente, segue em anexo a versão final de como ficou,

o unico porém, mas que não atrapalha nesse projeto, é que quando existe o arquivo o nome do segundo fica todo em maiúsculo. mas está funcionando lindamente.

Preencher Hemograma V2.6.xlsm

não imaginava que a solução fosse tão simples, resolveu o problema. obrigado

não resolveria o problema porque o modelo na minha empresa é nome do paciente - nome do prprietario. o codigo precisaria identificar se o arquivo ja existe, se sim, adicionar (2) se ja existe (2) adicionar (3) etc. obrigado

um problema na minha planilha que gera exames em pdf é que eu consegui fazer a maioria das coisas gravando macros, e como o formulário está em uma aba, e o modelo a ser preenchido está em outra, quando roda o macro a tela fica piscando porque para o codigo funcionar precisa ficar alternando entre as abas, gostaria de saber se é possível rodar a macro na aba 2 sem precisar de sair da aba onde está o formulário. 

segue o codigo e o arquivo da minha planilha para analisarem, se puderem. obrigado

Sub ocultar()
'
' ocultar Macro
'

'
    Sheets("Exame").Select
    Range("A34:O42").Select
    Selection.EntireRow.Hidden = True
    Sheets("PREENCHER").Select
    Range("C25:C31").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
    End With
    Range("F25,F27,F29,F31").Select
    Range("F31").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Selection.ShapeRange.ZOrder msoBringToFront
    Range("E5:G5").Select
End Sub

fiquem À vontade para sugerir qualquer mudança, com muito esforço a planilha está ficando com um resultado bem legal. 

vou deixala em anexo. obrigado.

https://drive.google.com/file/d/0BynkAckdgWiOTXI1V0VkQndobk0/view?usp=sharing

olá, com muitas pesquisas consegui criar uma planilha que tem um formulário que gera um arquivo pdf com o nome de acordo com o valor de uma celula e outras coisinhas, um dos problemas é que na hora de gerar o arquivo, se o arquivo ja existe com esse nome ele é substituido, gostaria que fosse possivel adicionar uma numeração tipo (2).pdf se o arquivo existir.

Sub salvar()
'
' salvar Macro
'
Dim nome As String
nome = "C:\Users\Jean\Desktop\exames pdf\" & Range("E5") & " - " & Range("k7") & ".pdf"
'
    Sheets("Exame").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nome, Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    Sheets("PREENCHER").Select
    Range("E5:G5").Select
End Sub

fiquem À vontade para sugerir qualquer mudança, com muito esforço a planilha está ficando com um resultado bem legal. 

vou deixala em anexo. obrigado.

https://drive.google.com/file/d/0BynkAckdgWiOTXI1V0VkQndobk0/view?usp=sharing

Preencher Hemograma.xlsm