Midori

@Gilberto_Silva Considerei a aba Nomes do mesmo arquivo com a coluna (A) dos nomes das planilhas, Sub Macro() Dim P As Worksheet Dim R As Range Set R = ThisWorkbook.Worksheets("Nomes").[A:A] For Each P In ThisWorkbook.Worksheets If P.Name <> "Nomes" Then If R.Find(What:=P.Name, LookAt:=xlWhole) Is Nothing Then Application.DisplayAlerts = False P.Delete Application.DisplayAlerts = True End If End If Next P End Sub

@LucasBR5 Faltou uma instrução no If para rodar corretamente. Macro corrigida, Sub Macro() Dim Arquivo As String Dim Diretorio As String Dim Indice As Integer Dim Pasta As Workbook Dim Planilha As Worksheet Diretorio = "C:\Teste\" Arquivo = Dir(Diretorio & "*.xlsx") Do Until Arquivo = "" If InStr(Arquivo, "(") <> 0 And InStr(Arquivo, ")") <> 0 Then Indice = Split(Split(Arquivo, "(")(1), ")")(0) + 1 Else Indice = 1 End If Set Pasta = Workbooks.Open(Diretorio & Arquivo) Pasta.ActiveSheet.[A1].CurrentRegion.Copy ThisWorkbook.Worksheets(Indice).[A1].PasteSpecial Application.CutCopyMode = False Pasta.Close Arquivo = Dir Loop End Sub

@LucasBR5 As planilhas são importadas sem ordem. O ideal seria se tivesse o nome da aba no próprio arquivo que será importado, mas se não tiver podemos usar o nome dos arquivos para especificar o índice da planilha e colocar as informações na ordem das abas desta forma, Sub Macro() Dim Arquivo As String Dim Diretorio As String Dim Indice As Integer Dim Pasta As Workbook Dim Planilha As Worksheet Diretorio = "C:\Teste\" Arquivo = Dir(Diretorio & "*.xlsx") Do Until Arquivo = "" If InStr(Arquivo, "(") And InStr(Arquivo, ")") Then Indice = Split(Split(Arquivo, "(")(1), ")")(0) + 1 Else Indice = 1 End If Set Pasta = Workbooks.Open(Diretorio & Arquivo) Pasta.ActiveSheet.[A1].CurrentRegion.Copy ThisWorkbook.Worksheets(Indice).[A1].PasteSpecial Pasta.Close Arquivo = Dir Loop End Sub Assim o arquivo xlsx do diretório C:\Teste que não tiver número entre parênteses será copiado para a primeira aba da planilha, o arquivo que tiver (1) para a segunda aba, (2) para a terceira, etc.

@LucasBR5 Para abrir os arquivos podemos usar um loop com a função Dir no diretório dos arquivos, Sub Macro() Dim Arquivo As String Dim Diretorio As String Dim Pasta As Workbook Dim Planilha As Worksheet Diretorio = "C:\Teste\" Arquivo = Dir(Diretorio & "*.xlsx") Do Until Arquivo = "" Set Pasta = Workbooks.Open(Diretorio & Arquivo) Pasta.ActiveSheet.[A1].CurrentRegion.Copy ThisWorkbook.Worksheets.Add ThisWorkbook.ActiveSheet.[A1].PasteSpecial Pasta.Close Arquivo = Dir Loop End Sub Faça um teste com a macro em uma nova planilha. Todos os arquivos xlsx do diretório C:\Teste serão abertos e os dados da aba ativa na região do range A1 serão copiados e colados para a planilha da macro em abas que serão criadas para cada arquivo. Mas como a sua planilha já tem as abas onde os dados devem ser colados, depois será preciso editar os comandos para colar nessas abas. Isso podemos adaptar se você der mais informações sobre os nomes ou padrão dessas abas.

@Matheus ZZ Você pode colocar essas condições em um loop infinito para sair apenas quando for s ou n, while(1){ printf("Você aceita? "); scanf("%c%*c",&c); if(c =='s'||c=='S'){ printf("Você aceitou"); break; }else if(c=='n'||c=='N'){ printf("Você recusou"); break; } }

@LucasBR5 Isso pode ser feito com macro para ir abrindo todos os arquivos xlsx do diretório e colando os dados de cada um na planilha.

@Jessy_1985 Tente usar a máscara em format no evento exit, TextBox7 = Format(TextBox7, "0##"".""###"".""###-##") ... TextBox31 = Format(TextBox31, "0#"".""###"".""###/####")

@josequali Tente usar AddPicture, p.ex DOC.Shapes.AddPicture "C:\Imagem.jpg"

@LucasExcel Se for para especificar a pasta da macro, no lugar de Windows("...") você pode usar ThisWorkbook, ... Selection.Copy ThisWorkbook.Activate Sheets("Scopo").Select Range("A1").Select ...

@hudsonsaldanha Quando você edita uma célula na mesma instância durante a execução de OnTime a contagem é interrompida até terminar a edição. Para evitar isso você pode abrir outra instância do Excel (clique com o botão direto no ícone do aplicativo e pressionando Alt abra o Excel). Assim a instância da planilha de OnTime ficará independente e não vai parar quando editar na outra.

Criar uma função para mostrar o tabuleiro como devair1010 fez é uma boa alternativa, dá até para aproveitar o loop e já verificar na própria função o vencedor, Também dá para informar a linha e a coluna no mesmo scanf, #include <stdio.h> int imprime_matriz(char M[3][3], char j){ int i, m=0; for(i=0;i<3;i++){ printf("\t\t %c | %c | %c\n",M[i][0],M[i][1],M[i][2]); if(M[i][0]==j && M[i][1]==j && M[i][2]==j) m = 1; if(M[0][i]==j && M[1][i]==j && M[2][i]==j) m = 1; if(i < 3-1) printf("\t\t ---+---+--- \n"); } if(M[0][0]==j && M[1][1]==j && M[2][2]==j) m = 1; if(M[0][2]==j && M[1][1]==j && M[2][0]==j) m = 1; return m; } int main(void) { char J = 'X', Matriz[3][3] = { ' ',' ',' ',' ',' ',' ',' ',' ',' '}; int jogadas = 0, j, i; while(jogadas <= 9){ printf(" JOGO DA VELHA \n"); int m = imprime_matriz(Matriz, J); if(m){ printf("O JOGADOR %d VENCEU!",((jogadas-1) % 2)+1); break; } printf("JOGADOR %d\n(LINHA,COLUNA): ",(jogadas % 2)+1); scanf("%d,%d",&i,&j); if(Matriz[i-1][j-1] == ' '){ J = 'X'; if(jogadas % 2) J = 'O'; Matriz[i-1][j-1] = J; jogadas++; } if(jogadas==9){printf("PARTIDA EMPATADA");break;} } return 0; }

Outra forma é com a função Dir, Sub Procurar() Dim Arquivo As String Arquivo = Dir("C:\Rodoviario\planilha_Rodoviario.csv") If Arquivo <> "" Then Workbooks.OpenText Filename:=Arquivo, DataType:=xlDelimited, _ TextQualifier:=xlTextQualifierNone, FieldInfo:=Array(1, 4), Local:=True Cells.Select Selection.Copy Windows("Relatório de expedição rodoviário.xlsm").Activate Sheets("Scopo").Select Range("A1").Select ActiveSheet.Paste End If End Sub

@patricia weber Uma melhoria que pode ser feita para não ter que usar loop para iniciar a matriz é já fazer isso na declaração. char Matriz[3][3] = {' ',' ',' ',' ',' ',' ',' ',' ',' '};

@hudsonsaldanha Eu acho que você está fazendo muitas chamadas a função Ontime. Isso pode ser um problema na hora da identificar o erro. Tente fazer apenas uma chamada e se for necessário fazer outra interrompa a anterior. Segue uma sugestão, Dim WkSheet As Worksheet Dim Contador As Integer Dim Continua As Boolean Sub Start() Dim WkBook As Workbook Set WkBook = Workbooks("mont carlo_wiener(1).xlsm") Set WkSheet = WkBook.Worksheet("Planilha2") If WkSheet.Range("G3") = "Normal" Then Call Tempo Else Call PeriodoPregão End If End Sub Sub Tempo() Contador = Contador + 1 With WkSheet If .Range("G3") = "Normal" Then .Range("G3") = Now If Contador >= 30 Then If .Range("B3") <> .Range("B4") Then 'inserçãodados .Range("B4:G141") = .Range("B3:G140") .Range("C3:E3") = .Range("F4") End If Contador = 1 End If 'inserçãodados2 .Range("AL4:AN141") = .Range("AL3:AN140") End With Application.OnTime Now + TimeValue("00:00:01"), "Tempo" End Sub Sub PeriodoPregão() On Error GoTo FIM If Hour(Now) > 9 And Hour(Now) < 18 Then Continua = False Else Continua = True End If Application.OnTime Now + TimeValue("00:00:30"), "PeriodoPregão", , Continua FIM: If Err.Number = 1004 Or Continua = False Then Call Start End Sub Na sub tempo dá para executar os comandos de insersão1 e 2 com apenas um Time a cada 1 segundo e no caso do comando para 30 segundos é só usar uma variável como contador. A variável boolean Continua quando é igual a False vai interromper o Time de PeridoPregão e chamar a Sub Start

@aprendiz_vba Tente usar a função Split como sugeri acima, é uma forma muito mais fácil e segura de pegar os campos do arquivo. Fiz a adaptação no seu código nesta parte, veja como é mais simples, Do While Not EOF(1) Line Input #1, entrada Cells(linha, 1).Value = Split(entrada, ";")(0) Cells(linha, 2).Value = Split(entrada, ";")(1) Cells(linha, 3).Value = DataDMA(Split(entrada, ";")(2)) Cells(linha, 4).Value = DataDMA(Split(entrada, ";")(3)) linha = linha + 1 Loop Close #1 Não precisa usar loop para identificar as colunas no arquivo, basta informar o índice da coluna (de 0 até n). Acima p.ex o índice 0 é o Id, o 1 é Empl_rcd, etc. O código completo fica assim, Function DataDMA(ByVal StrData As String) DataDMA = Split(StrData, "/")(1) & "/" & Split(StrData, "/")(0) & "/" & Split(StrData, "/")(2) End Function Sub importa_delimitado() Dim entrada As String 'linha do txt Dim i As Single 'número de caracteres Dim linha As Integer Dim coluna As Integer Dim texto As String 'texto a ser gravado na célula Dim ultimo As Boolean 'controle do último caracter da linha Dim W As Worksheet Dim Ficheiro As String Dim FD As FileDialog Dim strPath As String Dim xFile As String Dim xFiles As New Collection Dim j As Long Dim LR As Long Set W = Sheets("Arquivo_importado") W.Select W.UsedRange.EntireColumn.Delete Set FD = Application.FileDialog(msoFileDialogFolderPicker) FD.AllowMultiSelect = False FD.Title = "Selecione a Pasta que contem o arquivos TXT" If FD.Show = -1 Then strPath = FD.SelectedItems(1) End If If strPath = "" Then Exit Sub If VBA.Right(strPath, 1) <> "\" Then strPath = strPath & "\" xFile = VBA.Dir(strPath & "*.txt") If xFile = "" Then MsgBox "Processo abortado." & Chr(13) & "Nenhum arquivo foi selecionado." Exit Sub End If Do While xFile <> "" xFiles.Add xFile, xFile xFile = VBA.Dir() Loop Application.ScreenUpdating = False If xFiles.Count > 0 Then For j = 1 To xFiles.Count Ficheiro = strPath & xFiles.Item(j) With ThisWorkbook.ActiveSheet ' Adiciona nomes nas colunas For C = 1 To 11 .Cells(1, 1).Value = "Id" .Cells(1, 2).Value = "Empl_rcd" .Cells(1, 3).Value = "Matrícula" .Cells(1, 4).Value = "Nome" .Cells(1, 5).Value = "Data Nascimento" .Cells(1, 6).Value = "Composição Salarial" .Cells(1, 7).Value = "Sexo" .Cells(1, 8).Value = "CPF" .Cells(1, 9).Value = "Cargo" .Cells(1, 10).Value = "Filial" .Cells(1, 11).Value = "Admissão" .Cells(1, C).Font.Bold = True .Cells(1, C).HorizontalAlignment = xlLeft Next C End With Open Ficheiro For Input As #1 linha = 2 coluna = 1 Do While Not EOF(1) Line Input #1, entrada Cells(linha, 1).Value = Split(entrada, ";")(0) Cells(linha, 2).Value = Split(entrada, ";")(1) Cells(linha, 3).Value = DataDMA(Split(entrada, ";")(2)) Cells(linha, 4).Value = DataDMA(Split(entrada, ";")(3)) linha = linha + 1 Loop Close #1 Next Cells(2, 6).Select Range(Selection, Selection.End(xlDown)).Select For Each Cell In Selection numero = Str(Cell.Value) Cell.Activate ActiveCell.FormulaR1C1 = numero Next Selection.NumberFormat = "#,##0.00" ThisWorkbook.ActiveSheet.Range("E:E").HorizontalAlignment = xlRight ThisWorkbook.ActiveSheet.Range("A:K").Font.Size = 8 ThisWorkbook.ActiveSheet.Range("A:K").Columns.AutoFit End If Application.ScreenUpdating = True MsgBox "Importação concluída com sucesso." End Sub

@patricia weber A partida termina em empate quando o número de jogadas chega a nove sem um vencedor. Verificando melhor o código vi que a variável l é desnecessária, basta a variável jogadas. Acho que a variável l está aí para ser substituída pela variável jogadas. Para verificar se houve empate é só comparar, if(jogadas==9){ printf ("PARTIDA EMPATADA"); break; }

@patricia weber 1) Comece declarando as variáveis: Matriz e l. Para declarar uma variável coloque o tipo e o nome, p.ex, int teste; char Tabela[3][3]; Acima declarei duas variáveis, uma inteira e uma matriz/array 3x3. 2) Inicie os valores da matriz, veja que tem três linhas para isso. Iniciar significa atribuir valores (caractere em branco) a cada posição. Para isso use dois loops/For. 3) O parâmetro de scanf é igual ao scanf logo acima, mas com a variável j. 4) Incremente l e compare a condição de empate. Assim já dá para testar o código e depois acertar outras partes.

@Mazinhaa A outra macro deixe no módulo, coloque esta em ThisDocument, Private WithEvents App As Application Private Somar As Boolean Private Sub Document_Open() Set App = Word.Application Somar = True End Sub Private Sub App_DocumentBeforeSave(ByVal Doc As Document, _ SaveAsUI As Boolean, Cancel As Boolean) If Somar = True Then Call Macro: Somar = False End Sub

Veja que os comentários já dão uma dica do que fazer.

@Mazinhaa Dá para mudar a numeração quando o documento for salvo. Aí toda vez que abrir e salvar (mesmo se for várias vezes) o incremento será feito apenas uma vez. Seria isso?

@Vulgo_Lobo Nos testes If você está usando incorretamente o operador de atribuição =. Para comparar use ==, Forma correta, if (b == 0) if (x == 2) Você pode simplificar o código e já retornar na função par o resultado do modulo, p.ex #include <stdio.h> int par(int n){ return !(n % 2); } int main(){ int n; printf("Digite o valor: "); scanf("%d",&n); if(par(n)) printf("Par\n"); else printf("Impar\n"); return 0; }

@Mazinhaa Com macro poderia ser assim, veja se resolve. O número será incrementado ao aviso na primeira linha toda vez que rodar o código. Sub Macro() Dim R As Range Dim Aviso, S() As String Aviso = "AVISO DE LANÇAMENTO Nº" Set R = ActiveDocument.Paragraphs(1).Range If R = "" Then R = Aviso & vbCrLf S = Split(R, " ") If IsNumeric(S(UBound(S))) Then R = Aviso & " " & S(UBound(S)) + 1 & vbCrLf Else R = Aviso & " 1" & vbCrLf End If End Sub

O separador é de acordo com as opções regionais do sistema. No padrão Inglês/USA é vírgula.

@LucasExcel Sim, é só colocar na sub do botão no evento Click. Na planilha anexada só tem um botão no formulário, o CommandButton1. No primeiro código que eu postei os valores são inseridos quando o botão é pressionado.

@aprendiz_vba Você pode tentar usar uma função para inverter o dia com o mês da data, p.ex Function DataDMA(StrData As String) DataDMA = Split(StrData, "/")(1) & "/" & Split(StrData, "/")(0) & "/" & Split(StrData, "/")(2) End Function A parte com a alteração, For i = 1 To Len(entrada) If Mid(entrada, i, 1) = ";" Then If coluna = 3 Or coluna = 4 Then texto = DataDMA(texto) Cells(linha, coluna).Value = texto coluna = coluna + 1 texto = "" Else 'Se for o último caracter, grava na célula If i = Len(entrada) Then texto = texto & Mid(entrada, i, 1) If coluna = 3 Or coluna = 4 Then texto = DataDMA(texto) Cells(linha, coluna).Value = texto coluna = coluna + 1 ... Obs: Uma melhoria que você pode fazer no código é usar Split para pegar os campos do arquivo, assim não terá necessidade de usar loop para identificar ;. Veja neste tópico como fazer: