If e SaveAs

Hai un problema con Excel?

Nuova discussione

If e SaveAs
di Simone (utente non iscritto) data: 06/08/2014 20:31:18
Ciao a tutti, avrei bisogno di una mano...
vi spiego la situazione
ho 2 cartelle che chiamerò cartella1 e cartella2
in cartella1 ho un file excel (Wb1) dove ho una lista di voci nella colonna a
e un file excel (Wb2) che possiamo considerare come un template

1. ho bisogno di una macro che mi permetta di salvare una copia di Wb2 in cartella2 con il nome di una cella selezionata, per poi collegare la cella tramite collegamento ipertestuale al file creato.
tutto questo però, NON sovrascrivendo il file nel caso esistesse già, ma creando il link nel caso non ci fosse.

2.oltre a questo vorrei avere una versione della stessa macro, che facesse lo stesso lavoro per tutta la colonna A senza dover selezionare le celle manualmente..

Questo è il codice che ho scritto... per la versione 1
funziona, ma sovrascrive i file (cosa che non voglio che accada)

ditemi voi che correzioni devo fare... grazie
Il codice sicuramente è sicuramente ottimizzato, ma mi sono appena avvicinato alla programmazione.

Sub Vuoto()
'
' Vuoto Macro
'
Cartella = "C:cartella2"
NomeFile = ActiveCell.FormulaR1C1
Dim WB As Workbook
Set WB = Workbooks.Open("C:cartella1vuoto.xlsx")
Dim FilePath As String
fname = Cartella & NomeFile + ".xlsx"

If Dir(Cartella) = fname Then
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Cartella & NomeFile + ".xlsx", TextToDisplay:=NomeFile
    WB.Close
ElseIf Dir(Cartella) <> fname Then

    Application.DisplayAlerts = False
    WB.SaveAs Filename:= _
        Cartella & NomeFile, FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
    WB.Close
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Cartella & NomeFile + ".xlsx", TextToDisplay:=NomeFile

    
End If
End Sub

di lepat (utente non iscritto) data: 06/08/2014 22:16:37
allega i file
di simone (utente non iscritto) data: 06/08/2014 22:27:08
file allegati
di lepat (utente non iscritto) data: 07/08/2014 10:54:51
hai allegato dei file in cui devo scrivere io i path, come faccio a capire dove sta l'errore se ce li scrivo io ?

di Simone (utente non iscritto) data: 07/08/2014 18:59:20
i path li ho lasciati da mettere perchè così non dovevi ricrearti la struttura delle cartelle...
ho risolto comunque.... mi ci sono messo un pò e ho risolto...
allego i due codici, così magari risolvo un problema a qualcuno e se vedi qualcosa da migliorare, sono aperto a suggerimenti... ecco qui:

Questo è il 1°:

Sub CreaVuotoDosi()
Cartella = "C:UsersVanessaDesktop
icetteRicette"
NomeFile = ActiveCell.FormulaR1C1
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Cartella & NomeFile + ".xlsx", TextToDisplay:=NomeFile
fname = Cartella & NomeFile + ".xlsx"
If Dir(fname) = "" Then
Dim WB As Workbook
Set WB = Workbooks.Open("C:UsersVanessaDesktop
icettewb2.xlsx")
WB.Activate
    Application.DisplayAlerts = False
        WB.SaveAs Filename:= _
            Cartella & NomeFile, FileFormat _
            :=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
WB.Close
Else
End If
End Sub

Questo il 2°:

Sub TuttaLaColonna()
Dim rng As Range
Dim cell As Variant
Set rng = Range("A2:A250")
For Each cell In rng
Cartella = "C:UsersVanessaDesktop
icette
icette"
NomeFile = cell
    If cell.Value <> "" Then
ActiveSheet.Hyperlinks.Add Anchor:=cell, Address:= _
        Cartella & NomeFile + ".xlsx", TextToDisplay:=NomeFile
fname = Cartella & NomeFile + ".xlsx"
If Dir(fname) = "" Then
Dim WB As Workbook
Set WB = Workbooks.Open("C:UsersVanessaDesktop
icettewb2.xlsx")
WB.Activate
    Application.DisplayAlerts = False
        WB.SaveAs Filename:= _
            Cartella & NomeFile, FileFormat _
            :=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
WB.Close
Else
End If
End If
Next cell
 
End Sub

Vuoi Approfondire?