Stellar Blade Un'esclusiva PS5 che sta facendo discutere per l'eccessiva bellezza della protagonista. Vieni a parlarne su Award & Oscar!

Excel Forum Per condividere esperienze su Microsoft Excel

non creare nuove tabelle

  • Messaggi
  • OFFLINE
    maxma62
    Post: 788
    Registrato il: 28/12/2009
    Città: CITTADELLA
    Età: 62
    Utente Senior
    excel 2007/365
    00 22/06/2018 18:03
    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
  • OFFLINE
    maxma62
    Post: 788
    Registrato il: 28/12/2009
    Città: CITTADELLA
    Età: 62
    Utente Senior
    excel 2007/365
    00 22/06/2018 19:08
    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
  • OFFLINE
    maxma62
    Post: 789
    Registrato il: 28/12/2009
    Città: CITTADELLA
    Età: 62
    Utente Senior
    excel 2007/365
    00 22/06/2018 19:56
    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
  • OFFLINE
    patel45
    Post: 4.103
    Registrato il: 13/03/2012
    Città: LIVORNO
    Età: 78
    Utente Master
    2010
    00 23/06/2018 18:10
    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
  • OFFLINE
    maxma62
    Post: 790
    Registrato il: 28/12/2009
    Città: CITTADELLA
    Età: 62
    Utente Senior
    excel 2007/365
    00 23/06/2018 18:14
    Ciao patel, il mio ultimo codice era un tentativo...
    max
    ____________________________
    versione excel 365 ufficio
    versione excel 2007 casa
  • OFFLINE
    maxma62
    Post: 791
    Registrato il: 28/12/2009
    Città: CITTADELLA
    Età: 62
    Utente Senior
    excel 2007/365
    00 23/06/2018 22:57
    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
  • OFFLINE
    patel45
    Post: 4.104
    Registrato il: 13/03/2012
    Città: LIVORNO
    Età: 78
    Utente Master
    2010
    00 24/06/2018 14:18
    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
  • OFFLINE
    maxma62
    Post: 792
    Registrato il: 28/12/2009
    Città: CITTADELLA
    Età: 62
    Utente Senior
    excel 2007/365
    00 24/06/2018 14:26
    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
  • OFFLINE
    patel45
    Post: 4.105
    Registrato il: 13/03/2012
    Città: LIVORNO
    Età: 78
    Utente Master
    2010
    00 24/06/2018 17:06
    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
  • OFFLINE
    maxma62
    Post: 793
    Registrato il: 28/12/2009
    Città: CITTADELLA
    Età: 62
    Utente Senior
    excel 2007/365
    00 24/06/2018 19:02
    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
  • OFFLINE
    patel45
    Post: 4.106
    Registrato il: 13/03/2012
    Città: LIVORNO
    Età: 78
    Utente Master
    2010
    00 25/06/2018 08:48
    In effetti non ho capito a cosa ti serve questa macro

    ----------
    Win 10 - Excel 2010
    allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Soluzioni Excel Domande e Risposte
Passa alla versione desktop

  • Anteprima