About Me
Com tecnologia do Blogger.
Seguidores
Estatisticas
2006-06-30
VBA: Impressão de cópias numeradas sequencialmente
1:01 da manhã |
Publicada por
JRod - PORTUGAL |
Editar mensagem
Num newsgroup de Excel, foi colocada a seguinte questão:
"Pretendo imprimir n cópias de uma folha em excel, mas pretendo que cada uma delas tenha um número diferente, tipo a numeração de um livro."
Resposta possível, em VBA:
Sub ImprimeSequencial()
Dim StartNumber, EndNumber, TempNumber, TempAnswer As Integer
Do
StartNumber = InputBox("Indique o primeiro número da Sequencia")
EndNumber = InputBox("Indique o último número da Sequencia")
TempAnswer = MsgBox("Vão ser impressas " & EndNumber - StartNumber + 1 & _
" folhas! OK?", vbYesNoCancel, "Confirmar números...")
Select Case TempAnswer
Case vbCancel
Exit Sub
Case vbYes
Exit Do
End Select
Loop
For TempNumber = StartNumber To EndNumber
ActiveWorkbook.Sheets("Sheet1").Range("E30").Value = TempNumber
ActiveWorkbook.Sheets("Sheet1").PrintOut
Next TempNumber
End Sub
ATENÇÃO:
Em:
ActiveWorkbook.Sheets("Sheet1") - alterar "Sheet1" pelo nome da Sheet pretendida;
Em:
Range("E30"), alterar para a célula onde se pretende que apareça a numeração para impressão.
"Pretendo imprimir n cópias de uma folha em excel, mas pretendo que cada uma delas tenha um número diferente, tipo a numeração de um livro."
Resposta possível, em VBA:
Sub ImprimeSequencial()
Dim StartNumber, EndNumber, TempNumber, TempAnswer As Integer
Do
StartNumber = InputBox("Indique o primeiro número da Sequencia")
EndNumber = InputBox("Indique o último número da Sequencia")
TempAnswer = MsgBox("Vão ser impressas " & EndNumber - StartNumber + 1 & _
" folhas! OK?", vbYesNoCancel, "Confirmar números...")
Select Case TempAnswer
Case vbCancel
Exit Sub
Case vbYes
Exit Do
End Select
Loop
For TempNumber = StartNumber To EndNumber
ActiveWorkbook.Sheets("Sheet1").Range("E30").Value = TempNumber
ActiveWorkbook.Sheets("Sheet1").PrintOut
Next TempNumber
End Sub
ATENÇÃO:
Em:
ActiveWorkbook.Sheets("Sheet1") - alterar "Sheet1" pelo nome da Sheet pretendida;
Em:
Range("E30"), alterar para a célula onde se pretende que apareça a numeração para impressão.
2006-06-12
VBA: UDF - CalculaData() - Função de Data
7:04 da tarde |
Publicada por
JRod - PORTUGAL |
Editar mensagem
Se pretendermos somar dias, meses e anos a uma determinada data, como no exemplo:
podemos utilizar uma UDF:
Public Function CalculaData(ByVal datDataInicial As Date, ByVal intAnos As _
Integer, ByVal intMeses As Integer, ByVal intDias As Integer) As Date
' Utilização da Função de VBA DateAdd()
' Soma Anos, Meses e Dias a uma determinada Data
' Exemplo da Função numa célula: Em A1: = =CalculaData("1-1-2006";0;5;11)
' Ou seja, soma 0 anos, 5 meses e 11 dias à data 1/1/2006 - Resultado: 12/06/2006
' Atenção: é preciso formatar a célula como Data!
Dim datResult As Date
datResult = DateAdd("yyyy", intAnos, datDataInicial)
datResult = DateAdd("m", intMeses, datResult)
datResult = DateAdd("d", intDias, datResult)
CalculaData = datResult
End Function
Tópicos relacionados:
Função DATEADD()
Adicionar datas
podemos utilizar uma UDF:
Public Function CalculaData(ByVal datDataInicial As Date, ByVal intAnos As _
Integer, ByVal intMeses As Integer, ByVal intDias As Integer) As Date
' Utilização da Função de VBA DateAdd()
' Soma Anos, Meses e Dias a uma determinada Data
' Exemplo da Função numa célula: Em A1: = =CalculaData("1-1-2006";0;5;11)
' Ou seja, soma 0 anos, 5 meses e 11 dias à data 1/1/2006 - Resultado: 12/06/2006
' Atenção: é preciso formatar a célula como Data!
Dim datResult As Date
datResult = DateAdd("yyyy", intAnos, datDataInicial)
datResult = DateAdd("m", intMeses, datResult)
datResult = DateAdd("d", intDias, datResult)
CalculaData = datResult
End Function
Função DATEADD()
Adicionar datas
2006-06-04
Excel: Vários métodos para um mesmo fim...
3:03 da manhã |
Publicada por
JRod - PORTUGAL |
Editar mensagem
Tomemos, por exemplo, em A1, o seguinte Nome + Apelido: "Jorge Rodrigues"
Para inserir o Nome numa outra célula:
=LEFT(A1;FIND(" ";A1)-1)
ou
=LEFT(TRIM(A1);FIND(" ";TRIM(A1))-1)
Para inserir o Apelido:
=RIGHT(A1;LEN(A1)-FIND(" ";A1))
ou
=MID(A1;FIND(" ";A1)+1;256)
ou
=RIGHT(A1;LEN(A1)-SEARCH(" ";A1;1))
ou
=MID(TRIM(A1);FIND(" ";TRIM(A1))+1;LEN(A1))
Código VBA de uma Função UDF para obter o Apelido:
Function apelido(tot)
For I = 0 To Len(tot) - 1
Var = Var & Mid(tot, Len(tot) - I, 1)
Next I
apelido = Right(tot, InStr(Var, " "))
End Function
em A1: =apelido(A1)
Para inserir o Nome numa outra célula:
=LEFT(A1;FIND(" ";A1)-1)
ou
=LEFT(TRIM(A1);FIND(" ";TRIM(A1))-1)
Para inserir o Apelido:
=RIGHT(A1;LEN(A1)-FIND(" ";A1))
ou
=MID(A1;FIND(" ";A1)+1;256)
ou
=RIGHT(A1;LEN(A1)-SEARCH(" ";A1;1))
ou
=MID(TRIM(A1);FIND(" ";TRIM(A1))+1;LEN(A1))
Código VBA de uma Função UDF para obter o Apelido:
Function apelido(tot)
For I = 0 To Len(tot) - 1
Var = Var & Mid(tot, Len(tot) - I, 1)
Next I
apelido = Right(tot, InStr(Var, " "))
End Function
em A1: =apelido(A1)
Subscrever:
Mensagens (Atom)