Ridelight

Hum... Parece-me interessante, sou capaz de experimentar!

No mínimo diferente.... ;oP

Já fui dar uma espreitadela, em relação a grafismo, deixo desde já aqui os meus parabens, pelo upgrade substancial. Relativamente à mecânica de jogo, sofreu também uma grande alteração, ainda me estou a adaptar, mas ou por falta de tempo meu, ou por ser totalmente diferente da inicial, sinto-me um bocado perdido, sei que tem os tutoriais e as janelas que indicam, e estão bem conseguidos. Vou continuar a experimentar. E a versão mobile?

Obrigado pela disponibilidade, vou ver se me entendo... ;oP

Sim exatamente, era mesmo isso, mas se podesses mostrar em código era mais fácil, obrigado.

Boa tarde, há alguma forma de actualizar apenas o código de um .xlsm sem perder dados nas folhas de dados?

Obrigado! Funciona na perfeição.

Tenho o seguinte código: Sub Atraso() Worksheets("Control").Range("G13").Value = Now() MsgBox "Registou um atraso de " & Worksheets("Control").Range("H13").Value End Sub A célula H13 está formatada como horas, mas na msgbox aparece 40596.3284 em vez de 01:00:16.

Bem eu estou a testar, e estou a gostar, sobretudo das evoluções que tem surgido com as sucessivas builds. Estou agora a tentar a FBL_Awesome1501 9935.

Obrigado!

Bom dia, gostaria que a aplicação executasse o seguinte código ao abrir, mas não está a funcionar, o que estou a fazer de errado? Private Sub Workbook_Open() If Worksheets("M").Range("M1").Value = "1" Then Label13.BackColor = vbGreen If Worksheets("M").Range("M1").Value = "1" Then total.Caption = total + 1 If Worksheets("M").Range("M1").Value = "2" Then Label13.BackColor = vbYellow If Worksheets("M").Range("M1").Value = "2" Then total.Caption = total - 1 If Worksheets("M").Range("M1").Value = "3" Then Label13.BackColor = vbGreen If Worksheets("M").Range("M1").Value = "3" Then total.Caption = total + 1 If Worksheets("M").Range("M1").Value = "4" Then Label13.BackColor = vbRed If Worksheets("M").Range("M1").Value = "4" Then total.Caption = total - 1 If Worksheets("P").Range("M1").Value = "1" Then Label31.BackColor = vbGreen If Worksheets("P").Range("M1").Value = "1" Then total.Caption = total + 1 If Worksheets("P").Range("M1").Value = "2" Then Label31.BackColor = vbYellow If Worksheets("P").Range("M1").Value = "2" Then total.Caption = total - 1 If Worksheets("P").Range("M1").Value = "3" Then Label31.BackColor = vbGreen If Worksheets("P").Range("M1").Value = "3" Then total.Caption = total + 1 If Worksheets("P").Range("M1").Value = "4" Then Label31.BackColor = vbRed If Worksheets("P").Range("M1").Value = "4" Then total.Caption = total - 1 If Worksheets("P").Range("M1").Value = "1" Then Label5.BackColor = vbGreen If Worksheets("P").Range("M1").Value = "1" Then total.Caption = total + 1 If Worksheets("P").Range("M1").Value = "2" Then Label5.BackColor = vbYellow If Worksheets("P").Range("M1").Value = "2" Then total.Caption = total - 1 If Worksheets("P").Range("M1").Value = "3" Then Label5.BackColor = vbGreen If Worksheets("P").Range("M1").Value = "3" Then total.Caption = total + 1 If Worksheets("P").Range("M1").Value = "4" Then Label5.BackColor = vbRed If Worksheets("P").Range("M1").Value = "4" Then total.Caption = total - 1 Gespoint.Show End Sub

Windows 8.1 e Windows Server 2008 r2

Bom dia, podes definir área de impressão e depois a aplicação só imprime esse espaço.

Graficamente bastante interessante, e o conceito também parece que tem algum potencial.

Obrigado!

Bom dia alguém sabe o código para mostrar uma mensagem aleatória baseada num intervalo de células, e que mude a cada 10 minutos?

Obrigado!

Eu queria guardar as folhas do livro para pdf. Mas queria de por exemplo A1:G35 Dim GuardarPDF As String MGuardarPDF = "C:\Ponto\Ficheiro.pdf" ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyFullName, _ Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=True Mas isto só me grava a primeira folha do livro e guarda 6586 páginas.

Foi com a que des-te, tive de experimentar, obrigado!

Alguém sabe como criar um timer, uma vez que não existe o timer como no VB6, é possível em vba?

Eu acabei por fazer de forma mais "artesanal" Private Sub Carina_Click() For Each w In Application.Workbooks w.Save Next w Dia.Caption = Day(Now) Worksheets("AnaCarina").Range("M1").Value = Worksheets("AnaCarina").Range("M1").Value + 1 If Worksheets("AnaCarina").Range("M1").Value = "2" Then Worksheets("AnaCarina").Range("B" & Dia.Caption + 1).Value = Now() If Worksheets("AnaCarina").Range("M1").Value = "2" Then Image46.Visible = True If Worksheets("AnaCarina").Range("M1").Value = "2" Then MsgBox "Olá Ana Carina!" & vbCrLf & "A tua entrada foi registada!" & vbCrLf & Now(), vbInformation, "GESPOINT" If Worksheets("AnaCarina").Range("M1").Value = "2" Then movimento.Caption = "Ana Carina - Entrada" If Worksheets("AnaCarina").Range("M1").Value = "2" Then total.Caption = total + 1 If Worksheets("AnaCarina").Range("M1").Value = "4" Then Worksheets("AnaCarina").Range("C" & Dia.Caption + 1).Value = Now() If Worksheets("AnaCarina").Range("M1").Value = "4" Then Image46.Visible = False If Worksheets("AnaCarina").Range("M1").Value = "4" Then MsgBox "Olá Ana Carina!" & vbCrLf & "A tua saida foi registada!" & vbCrLf & Now(), vbInformation, "GESPOINT" If Worksheets("AnaCarina").Range("M1").Value = "4" Then movimento.Caption = "Ana Carina - Saída" If Worksheets("AnaCarina").Range("M1").Value = "4" Then total.Caption = total - 1 If Worksheets("AnaCarina").Range("M1").Value = "6" Then Worksheets("AnaCarina").Range("D" & Dia.Caption + 1).Value = Now() If Worksheets("AnaCarina").Range("M1").Value = "6" Then Image46.Visible = True If Worksheets("AnaCarina").Range("M1").Value = "6" Then MsgBox "Olá Ana Carina!" & vbCrLf & "A tua entrada foi registada!" & vbCrLf & Now(), vbInformation, "GESPOINT" If Worksheets("AnaCarina").Range("M1").Value = "6" Then movimento.Caption = "Ana Carina - Entrada" If Worksheets("AnaCarina").Range("M1").Value = "6" Then total.Caption = total + 1 If Worksheets("AnaCarina").Range("M1").Value = "8" Then Worksheets("AnaCarina").Range("E" & Dia.Caption + 1).Value = Now() If Worksheets("AnaCarina").Range("M1").Value = "8" Then Image46.Visible = False If Worksheets("AnaCarina").Range("M1").Value = "8" Then MsgBox "Olá Ana Carina!" & vbCrLf & "A tua saida foi registada!" & vbCrLf & Now(), vbInformation, "GESPOINT" If Worksheets("AnaCarina").Range("M1").Value = "8" Then movimento.Caption = "Ana Carina - Saída" If Worksheets("AnaCarina").Range("M1").Value = "8" Then total.Caption = total - 1 If Worksheets("AnaCarina").Range("M1").Value = "8" Then Worksheets("AnaCarina").Range("M1").Value = "0" End Sub

Encontrei estes, vê se servem para o efeito pretendido. Sub Ck() Dim strStartPath As String strStartPath = "C:\" 'ENTER YOUR START FOLDER HERE ListFolder strStartPath End Sub Sub ListFolder(sFolderPath As String) Dim FS As New FileSystemObject Dim FSfolder As Folder Dim subfolder As Folder Dim i As Integer Set FSfolder = FS.GetFolder(sFolderPath) For Each subfolder In FSfolder.SubFolders DoEvents i = i + 1 'added this line Cells(i, 1) = subfolder 'commented out this one 'Debug.Print subfolder Next subfolder Set FSfolder = Nothing 'optional, I suppose MsgBox "Total sub folders in " & sFolderPath & " : " & i End Sub Option Explicit Sub TestListFolders() Application.ScreenUpdating = False 'create a new workbook for the folder list 'commented out by dr 'Workbooks.Add 'line added by dr to clear old data Cells.Delete ' add headers With Range("A1") .Formula = "Folder contents:" .Font.Bold = True .Font.Size = 12 End With Range("A3").Formula = "Folder Path:" Range("B3").Formula = "Folder Name:" Range("C3").Formula = "Size:" Range("D3").Formula = "Subfolders:" Range("E3").Formula = "Files:" Range("F3").Formula = "Short Name:" Range("G3").Formula = "Short Path:" Range("A3:G3").Font.Bold = True 'ENTER START FOLDER HERE ' and include subfolders (true/false) ListFolders "C:\", True Application.ScreenUpdating = True End Sub Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean) ' lists information about the folders in SourceFolder ' example: ListFolders "C:\", True Dim FSO As Scripting.FileSystemObject Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder Dim r As Long Set FSO = New Scripting.FileSystemObject Set SourceFolder = FSO.GetFolder(SourceFolderName) 'line added by dr for repeated "Permission Denied" errors On Error Resume Next ' display folder properties r = Range("A65536").End(xlUp).Row + 1 Cells(r, 1).Formula = SourceFolder.Path Cells(r, 2).Formula = SourceFolder.Name Cells(r, 3).Formula = SourceFolder.Size Cells(r, 4).Formula = SourceFolder.SubFolders.Count Cells(r, 5).Formula = SourceFolder.Files.Count Cells(r, 6).Formula = SourceFolder.ShortName Cells(r, 7).Formula = SourceFolder.ShortPath If IncludeSubfolders Then For Each SubFolder In SourceFolder.SubFolders ListFolders SubFolder.Path, True Next SubFolder Set SubFolder = Nothing End If Columns("A:G").AutoFit Set SourceFolder = Nothing Set FSO = Nothing 'commented out by dr 'ActiveWorkbook.Saved = True End Sub Podes lêr mais aqui: http://www.erlandsendata.no/english/index.php?d=envbafolderslistfoldersscripting http://www.vbforums.com/showthread.php?244880-VB-List-all-subfolders-in-a-specific-folder&s=

For Each w In Application.Workbooks w.Save Next w Obrigado, mas só com este é que guarda, o outro apenas dá indicação que está guardado sem guardar.

Dá-me erro "Wrong number of arguments or invalid property assingnment"

Alguem sabe o código em vba para gravar automaticamente o livro em vba?