Excel Forum

	Soluzioni Excel Domande e Risposte
		non creare nuove tabelle

Pagina precedente | 1 | Pagina successiva

Vota | Stampa | Notifica email

« Discussione Precedente | Lista | Discussione Successiva »

Autore

non creare nuove tabelle

Ultimo Aggiornamento: 25/06/2018 08:48

maxma62

Post: 788

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

22/06/2018 18:03

00#1

Questa macro cerca in un percorso di rete determintate tabelle in un file .mdb aperto con Excel:

Option Explicit


Dim path_fisso As String
Dim commessa As String
Dim file As String
Dim avviso As String


Sub ricerca_1()

Dim WK1 As Workbook
Set WK1 = ThisWorkbook



If ActiveSheet.Range("B2") = "" Or ActiveSheet.Range("C3") = "file non presente" Then
     
   avviso = MsgBox("Sign. " & Environ("UserName") & "" _
   & Chr(13) & "dati non disponibili!", _
   vbCritical, "ERRORE")
  
   Exit Sub
End If


commessa = ActiveSheet.Range("B2").Value


  Workbooks.OpenDatabase Filename:= _
        "\\xxx_xxx\maxxxpxx\TOPxxx\Maxxx\xxx\" & commessa & "\maxxxx.mdb", CommandText _
        :=Array("Sx1"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
           
   ActiveWorkbook.SaveAs Filename:=WK1.Path & "\" & "Cartel1.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
             
        
  Workbooks.OpenDatabase Filename:= _
        "\\xxx_xxx\maxxxpxx\TOPxxx\Maxxx\xxx\" & commessa & "\maxxxx.mdb", CommandText _
        :=Array("Sx2"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
        
   ActiveWorkbook.SaveAs Filename:=WK1.Path & "\" & "Cartel2.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False     
               
            
'blocco qui?



 
  ThisWorkbook.Sheets("ricerca").Activate
  
  
 
End Sub

Trova 2 tabelle e le salva con il nome di defautl in cui si aprono Cartel1/Cartel2 nelle stessa
cartella del file excel principale.
Fin qui tutto bene.
Chiedo un aiuto per una modifica:
Questa macro è collegata ad un pulsante che la avvia crea le 2 tabelle e le salva,
se clicco ancora una volta crea altre tabelle Cartel3/4 - Cartel 4/5 ecc..
E possible mettere un blocco - un contatore che controlli se sono già presenti
le 2 tabelle Cartel1/2 non crei altre tabelle?
Spero di essermi spiegato.
Un saluto.
max

[Modificato da maxma62 22/06/2018 19:09]

____________________________
versione excel 365 ufficio
versione excel 2007 casa

maxma62

Post: 788

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

22/06/2018 19:08

00#2

Forse qualcosa del genere:
se nella cartella dove di salvano cartel/2 queste sono presenti
fermare l'esecuaiozione della macro: Sub ricerca_1()
max

____________________________
versione excel 365 ufficio
versione excel 2007 casa

maxma62

Post: 789

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

22/06/2018 19:56

00#3

Sub FileExists()

Dim FilePath As String
Dim TestStr As String
Dim WK1 As Workbook
Set WK1 = ThisWorkbook

'==========================================================================================

' macro da inserire alla fine della macro Sub ricerca_1()

'FilePath = "C:\Users\massimo\Desktop\Nuova cartella\Cartel1.xlsx"
'FilePath = "C:\Users\massimo\Desktop\Nuova cartella\Cartel2.xlsx"

FilePath = WK1.Path & "\" & "Cartel1.xlsx"
FilePath = WK1.Path & "\" & "Cartel2.xlsx"

TestStr = ""

On Error Resume Next

TestStr = Dir(FilePath)

On Error GoTo 0

If TestStr <> "" Then

MsgBox "Tabelle 1/2 già caricate"

'qui dovrebbe bloccare la macro Sub ricerca_1()
'per non creare nuove Tabelle

End If

'==========================================================================================

End Sub

[Modificato da maxma62 22/06/2018 19:57]

____________________________
versione excel 365 ufficio
versione excel 2007 casa

patel45

Post: 4.103

Registrato il: 13/03/2012

Città: LIVORNO

Età: 78

Utente Master

2010

OFFLINE

23/06/2018 18:10

00#4

Re:

maxma62, 22/06/2018 18.03:

se clicco ancora una volta crea altre tabelle Cartel3/4 - Cartel 4/5 ecc..

questo non è possibile col codice che hai allegato, i nomi dei file sono Cartel1 e Cartel2

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta

maxma62

Post: 790

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

23/06/2018 18:14

00#5

Ciao patel, il mio ultimo codice era un tentativo...
max

____________________________
versione excel 365 ufficio
versione excel 2007 casa

maxma62

Post: 791

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

23/06/2018 22:57

00#6

Ciao,
non so se è la migliore soluzione.
Ho pensato a un funzione "blocca pulsante" se la macro è stata avviata 1 volta:

'===============================================================================

Public flag As Integer

Option Explicit

If flag = 1 Then Exit Sub

Dim path_fisso As String
Dim commessa As String
Dim file As String
Dim avviso As String

Sub ricerca_1()

Dim WK1 As Workbook
Set WK1 = ThisWorkbook

If ActiveSheet.Range("B2") = "" Or ActiveSheet.Range("C3") = "file non presente" Then

avviso = MsgBox("Sign. " & Environ("UserName") & "" _
& Chr(13) & "dati non disponibili!", _
vbCritical, "ERRORE")

Exit Sub
End If

commessa = ActiveSheet.Range("B2").Value

Workbooks.OpenDatabase Filename:= _
"\\xxx_xxx\maxxxpxx\TOPxxx\Maxxx\xxx\" & commessa & "\maxxxx.mdb", CommandText _
:=Array("Sx1"), CommandType:=xlCmdTable, ImportDataAs:=xlTable

ActiveWorkbook.SaveAs Filename:=WK1.Path & "\" & "Cartel1.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Workbooks.OpenDatabase Filename:= _
"\\xxx_xxx\maxxxpxx\TOPxxx\Maxxx\xxx\" & commessa & "\maxxxx.mdb", CommandText _
:=Array("Sx2"), CommandType:=xlCmdTable, ImportDataAs:=xlTable

ActiveWorkbook.SaveAs Filename:=WK1.Path & "\" & "Cartel2.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'blocco qui?

ThisWorkbook.Sheets("ricerca").Activate

flag=1

End Sub

'===============================================================================

solo se possibile è inserire un avviso "tabelle già inserite" se clicco ancora nel pulsante.
e che poi si inserisca in una cella del foglio E7 "tabelle inserite"

[Modificato da maxma62 24/06/2018 09:04]

____________________________
versione excel 365 ufficio
versione excel 2007 casa

patel45

Post: 4.104

Registrato il: 13/03/2012

Città: LIVORNO

Età: 78

Utente Master

2010

OFFLINE

24/06/2018 14:18

00#7

continuo a non capire, i nomi sono fissi e quindi non è possibile creare nuove cartelle, al più vengono sovrascritte

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta

maxma62

Post: 792

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

24/06/2018 14:26

00#8

Adesso mi viene un dubbio..
Eppure sono convinto che crei altre cartelle.
Ora non ho la possibilità per controllare, domani in ufficio si.
Al limite è possibile aggiungere alla mia seonda macro se si riclicca una seconda volta
che appaia un avviso "tabelle già scaricate"
max

____________________________
versione excel 365 ufficio
versione excel 2007 casa

patel45

Post: 4.105

Registrato il: 13/03/2012

Città: LIVORNO

Età: 78

Utente Master

2010

OFFLINE

24/06/2018 17:06

00#9

Re:

prova così

Option Explicit
Dim path_fisso As String
Dim commessa As String
Dim file As String
Dim avviso As String

Sub ricerca_1()

Dim WK1 As Workbook
Set WK1 = ThisWorkbook
'----------------
FilePath = WK1.Path & "\" & "Cartel2.xlsx"
TestStr = Dir(FilePath)
If TestStr <> "" Then
  MsgBox "Tabelle 1/2 già caricate" 
  Exit Sub
end if
'-----------
If ActiveSheet.Range("B2") = "" Or ActiveSheet.Range("C3") = "file non presente" Then
     
   avviso = MsgBox("Sign. " & Environ("UserName") & "" _
   & Chr(13) & "dati non disponibili!", _
   vbCritical, "ERRORE")
  
   Exit Sub
End If

commessa = ActiveSheet.Range("B2").Value

  Workbooks.OpenDatabase Filename:= _
        "\\xxx_xxx\maxxxpxx\TOPxxx\Maxxx\xxx\" & commessa & "\maxxxx.mdb", CommandText _
        :=Array("Sx1"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
           
   ActiveWorkbook.SaveAs Filename:=WK1.Path & "\" & "Cartel1.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
       
  Workbooks.OpenDatabase Filename:= _
        "\\xxx_xxx\maxxxpxx\TOPxxx\Maxxx\xxx\" & commessa & "\maxxxx.mdb", CommandText _
        :=Array("Sx2"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
   ActiveWorkbook.SaveAs Filename:=WK1.Path & "\" & "Cartel2.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False     
  ThisWorkbook.Sheets("ricerca").Activate
End Sub

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta

maxma62

Post: 793

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

24/06/2018 19:02

00#10

Per provare a casa ho aggiunto la tua modfica a questa macro.
La macro apre 2 file Cartel1/2 con la tua modifica trova che sono presenti ma poi si ferma e non apre più Cartet1/2 che dovrebbe aprire segnalando poi che sono caricate:

Option Explicit



Sub Copia_da_FileAltro_2()


 Dim WK1 As Workbook, WK2 As Workbook, WK3 As Workbook ', WK4 As Workbook, WK5 As Workbook
    Dim Sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet ', sh4 As Worksheet, sh5 As Worksheet
    
    
    
Dim FilePath As String
Dim TestStr As String

 
        
   Set WK1 = ThisWorkbook
   
  
   '-----------------------------
FilePath = WK1.Path & "\" & "Cartel2.xlsx"

TestStr = Dir(FilePath)
If TestStr <> "" Then

  MsgBox "Tabelle 1/2 già caricate"
  
  
  Exit Sub
End If
'------------------------------

    
    
 Set WK1 = ThisWorkbook
    
    'Set WK2 = Workbooks("Cartel1.xlsx")
    Set WK2 = Workbooks.Open(WK1.Path & "/" & "Cartel1.xlsx")
    
    'Set WK3 = Workbooks("Cartel2.xlsx")
    Set WK3 = Workbooks.Open(WK1.Path & "/" & "Cartel2.xlsx")
     
    
    
End Sub

max

____________________________
versione excel 365 ufficio
versione excel 2007 casa

patel45

Post: 4.106

Registrato il: 13/03/2012

Città: LIVORNO

Età: 78

Utente Master

2010

OFFLINE