Basole

Segue a alteração na msg.: If MsgBox("CODIGO DE BARRAS GERADO COM SUCESSO: " & TextBox1.Text & TextBox2.Text & TextBox3.Text & _TextBox4.Text & TextBox5.Text & TextBox6.Text & TextBox7.Text & vbNewLine & vbNewLine & "Deseja Imprimir a Etiqueta ?", vbQuestion + vbYesNo, "Sucesso") = vbYes Then'Insira o codigo CriarEtiquetasElseExit SubEnd If Agora pra criar a etiqueta, xiiii são outros 500 ..

Pf poste sua planilha ou um exemplo proximo.

Vj. se é isso q precisa: Sub AdicionarAbastecer() With Sheets("Banco de Dados") .Range("L6", "T6").Rows.Copy .Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False .Range("A2:I" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort Key1:=.[A2], Order1:=xlDescending End WithEnd Sub

Segue ex. MsgBox "CODIGO DE BARRAS GERALDO COM SUCESSO: " & textbox1.Text & textbox2.Text & textbox3.Text & _textbox4.Text & textbox5.Text & textbox6.Text & textbox7.Text, 0, "Sucesso"

Acho que seria melhor se pudesse compartilhar sua planilha ou um exemplo similar.

Tente essa macro: protege a celula e o hyperlink contra edição, e permite a seleção. * click c/ o botao direito sobre o nome da aba, selecione exibir codigo e cole o cod. abaixo: Private Sub Worksheet_Activate()ActiveSheet.Protect Password:="1234", UserInterfaceOnly:=TrueEnd Sub

segue em anexo GERADOR.zip

segue um ex.: Sub GerarCodigo() Dim Cod As String: Cod = InputBox("Digite o código no seguinte formato:" & vbNewLine & "Ex.: 33 20 3 22 615 10 (s/ os espaços)" & _ vbNewLine & vbNewLine & vbNewLine & vbNewLine & "TIPO FAMILIA MARCA BICO UND TAMANHO ", _ "Gerador de Codigo de Barras") Dim sht As Worksheet: Set sht = Sheets("Gerador de Codigo") If Cod = Empty Then Exit Sub sht.[B15].Value = CodEnd Sub * Formate a celula B15 como texto.

Nessa planilha que anexou, tem uma ref. de vinculo com uma outra planilha: "Controle de Estoque Way VERSÃO 3.0.xlsm" que você. nao enviou ? .

Em B2 insira a formula: =SOMA((MÊS($A$1:$A$4)=2)*(ANO($A$1:$A$4)=2015)*1) Em C2: =SOMA((MÊS($A$1:$A$4)=3)*(ANO($A$1:$A$4)=2015)*1) -> Como é uma formula matricial, aperte F2 sobre a celula que contem a formula em seguida, as teclas (Cltr+Shift+Enter).

Não entendi, qual o criterio q será usado para criar esses numeros (codigo de barras). Outra coisa se for usar um leitor (scanner), normalmente o codigo de barras tem q ter um digito verificador

Olá Você quer apenas em macro? Eu acho que você pode fazê-lo, usando de validação personalizada protegendo contra edição, apenas o intervalo que deseja. Veja anexo, o exemplo. LinhaProtegidaComValidacao.xlsx

Bom dessa forma q você quer fazer terá q botar os botões em todas as abas acho inviavel p 30 abas . Fiz uma susestão com botao 'ribbon'. Veja se lhe atende. Click na aba 'Navegar em abas" , em seguida nos botões proxima ou anterior... Navegar em abas2.zip

Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet If Not Intersect(Target, Range("$A1:$A10")) Is Nothing Then 'AQUI: altere seu intervalo If Target.Value <> "" Then For Each ws In ActiveWorkbook.Worksheets If ws.Name = Target.Value Then ws.Activate: Exit For Next End If End IfEnd Sub * A macro só vai 'agir' no intervalo indicado. Altere de acordo c/ sua necessidade

Click botao direito sobre o nome da respect. aba e selecione "exibir codigo" e cole o cod abaixo: Private Sub Worksheet_Change(ByVal Target As Range)Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets If ws.Name = Target.Value Then ws.Activate: Exit For NextEnd Sub

Veja (anexo)se é isso q precisa: exmplo_lista-v1.xlsx

A planilha é compartilhada? Tente adaptar este codigo: Private Sub Workbook_Open2()Dim usersusers = ActiveWorkbook.UserStatusWith Workbooks.Add.Sheets(1) For Row = 1 To UBound(users, 1) .Cells(Row, 1).Value = users(Row, 1) .Cells(Row, 2).Value = users(Row, 2) Select Case users(Row, 3) Case 1 .Cells(Row, 3).Value = "Exclusivo" Case 2 .Cells(Row, 3).Value = "Compartilhado" End Select NextEnd WithEnd Sub

Public Function UserName() UserName = Environ$("UserName") End Function

Problema é que surgiu uma data maior que 24h... tipo "48:51:53" e ao invés de retornar o valor "2931m53s", esta retornando valor 51m53s... O código, da maneira que foi escrito, quando. se insere a hora maior que 24, ele converte para 1 dia + os respectivos minutos+ segs. e aparece neste formato. veja se dessa forma te ajuda: Sub Inserir_hora() Dim Exibir, Título, Tipo, hora, Hora_tt, Hr, Mn, SG Exibir = "Digite a hora ou Selecione uma Célula:" Título = "INSERT TEMPO/HORA" Tipo = 10 hora = Application.InputBox(Prompt:=Exibir, Title:=Título, Type:=Tipo, Default:="Formato Hora (hh:mm:ss) ex.:24:30:54") If Left(hora, 1) < 1 Then Hr = Format(Hour(hora), "00") & "h" Mn = Format(Minute(hora), "00") & "m" SG = Format(Second(hora), "00") & "s" Else Hr = "" Mn = Format(Left(hora, 1) * 24 * 60 + Minute(hora), "00") & "m" SG = Format(Second(hora), "00") & "s" End If If SG > 0 Then Hora_tt = Hr & "s" End If If Mn > 0 Then Hora_tt = Mn & SG End If If Hr > 0 Then Hora_tt = Hr & Mn & SG End If Selection.Value = Hora_ttEnd Sub

tente isso... hora_tt = Format(Hr, "00") & "h" & Format(Mn, "00") & "m" & Format(Sg, "00") & "s"

Sim, use o Sendspace, drive.google, etc...

.....tente este ex. : Private Sub Verif_Se_Existe() ' *** habilite a referencia Microsoft ActiveX data objects X.X library Dim nConn As New ADODB.Connection Dim Rs As ADODB.Recordset Dim sql As String, suaCelula As String suaCelula = Plan1.Range("A1").Value ' altere o local onde esta os dados If suaCelula = "" Then MsgBox "Insira os dados na celula [A1]!", 64, "Aviso" Exit Sub End If sql = "SELECT * FROM [NomeSuaTabela]" & _ " WHERE [CampoQquerProcurar] = '" & suaCelula & "';" Set Rs = New ADODB.Recordset nPath = "C:\Users\Admin\Desktop\Nome_do_Seu_Banco_de_Dados.mdb" ' altere o diretorio e nome do BD nConectar = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & nPath & ";" nConn.ConnectionString = nConectar nConn.Open Rs.Open sql, nConn If Rs.EOF = False Then MsgBox "frase XXXXXXXXX" Else MsgBox "Nao encontrado!" End If Set Rs = Nothing nConn.CloseEnd Sub

Segue ex funcao q verif se o diretorio existe: Function FileOrDirExists(PathName As String) As Boolean Dim iTemp As Integer On Error Resume Next iTemp = GetAttr(PathName) Select Case Err.Number Case Is = 0 FileOrDirExists = True Case Else FileOrDirExists = False End Select On Error GoTo 0End Function * use dessa forma em sua macro: Dim SeuPath As String SeuPath = ThisWorkbook.Path & "\SeuArquivo.*" ' exemploIf FileOrDirExists(SeuPath) Then'bla bla bla bla bla bla bla bla bla bla bla bla .....End If

Bom eu costumo usar o adodb para atualizar dados no access desta forma, veja uim exemplo abaixo: * Habilite a referencia indicada. Sub Atualiza()'Habilite a Referencia Microsoft ctiveX Data objects X.X Library Dim nConectar As String Dim nConn As New ADODB.Connection Dim nPath As String Dim rs As ADODB.Recordset way = "" & (Plan2.Cells(1, 2)) & "" caminho = "" & (way) & "" & (Plan2.Range("b2")) & "" 'Caminho do banco 'Variáveis Dim i As Long: i = 11 Do While Plan61.Range("A" & i) <> "" Ticket1 = Plan61.Range("A" & i) Status1 = Plan61.Range("H" & 1) HI1 = Plan61.Range("E" & i) HF1 = Plan61.Range("F" & i) Dta1 = Plan61.Range("B" & i) nConectar = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & caminho & ";" nConn.Open Set rs = New ADODB.Recordset With rs .Open "SELECT * FROM [" & (Plan2.Range("B3")) & "] WHERE [Ticket] LIKE '" & (Ticket1) & "';" & _ ";", nConn, adOpenKeyset, adLockOptimistic End With 'rs.Edit 'desabilitado rs.Fields("Status") = Status1 rs.Fields("Hora Inicial") = HI1 rs.Fields("Hora Final") = HF1 rs.Fields("Data") = Dta1 rs.Fields("Data Atualização") = Format(Now, "dd/mm/yy") rs.Fields("Hora Atualização") = Format(Now, "hh:mm:ss") i = i + 1 rs.Update Set rs = Nothing nConn.Close LoopEnd Sub

voce precisa fazer um loop atualizando as linhas das celulas referenciadas. tente alguma coisa assim: Sub Atualiza()Dim rs As Recordsetway = "" & (Plan2.Cells(1, 2)) & ""caminho = "" & (way) & "" & (Plan2.Range("b2")) & "" 'Caminho do banco'VariáveisDim i As Long: i = 11Do While Plan61.Range("A" & i) <> ""Ticket1 = Plan61.Range("A" & i)Status1 = Plan61.Range("H" & 1)HI1 = Plan61.Range("E" & i)HF1 = Plan61.Range("F" & i)Dta1 = Plan61.Range("B" & i)Set wks = DBEngine(0)Set Db = wks.OpenDatabase(caminho)Set rs = Db.OpenRecordset("SELECT * FROM [" & (Plan2.Range("B3")) & "] WHERE [Ticket] LIKE '" & (Ticket1) & "';") 'Referência, é o ticket com numeração automática que consta tanto no excel quanto no access.rs.Editrs.Fields("Status") = Status1rs.Fields("Hora Inicial") = HI1rs.Fields("Hora Final") = HF1rs.Fields("Data") = Dta1rs.Fields("Data Atualização") = Format(Now, "dd/mm/yy")rs.Fields("Hora Atualização") = Format(Now, "hh:mm:ss")i = i + 1rs.UpdateDb.CloseLoopEnd Sub * nao testado