Haluaisin Excelin tallentavan avatun työkirjan automaattisesti ja nimeävän sen määrätyn solun ja juoksevan numeron mukaan. (esim työkirja 1, työkirja 2 jne.)
Kiitos.
Tallenna+juokseva numero
AnnaKaisa
7
5605
Vastaukset
- remec
Tossa vaikka tommonen viritys, saat sen toimiin ku teet "taul2" laskentataulukkoon juoksevan numeroinnin , eli a1 = 1 a2 = 2 ..... a10000 =10000. nythän se käy hakemassa nimen tiedostolle laskentataulukon "taul1" a1 solusta
ja juoksevan numeron "taul2" taulukon a1- a65000 soluista, ts. sieltä asti kun olet juoksevaa numerointia sinne määritellyt.
Sub Makro2()
Sheets("Taul2").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
tieto = Range("a1")
Sheets("Taul1").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\" & Range("a1") & tieto & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
aika purkka viritys eikö =)- noviisi
Tervehdys!
Miten tuon virityksen saisi toimimaan lisäksi niin, että kyseinen juokseva numero siirtyy myös tiettyyn soluun. Esim. Taul1:n A1? - Kunde
noviisi kirjoitti:
Tervehdys!
Miten tuon virityksen saisi toimimaan lisäksi niin, että kyseinen juokseva numero siirtyy myös tiettyyn soluun. Esim. Taul1:n A1?vähän fiksummin...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Numero As String
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
Numero = HaeNumero(Range("A1"))
ActiveWorkbook.SaveAs Filename:="C:\" & Range("a1") & ".xls"
Range("A1") = "työkirja " & (Numero 1)
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End Sub
Function HaeNumero(Teksti As String)
Dim i As Integer
Dim sana As String
i = 1
Do Until sana Like (" *")
sana = Right(Teksti, i)
i = i 1
Loop
HaeNumero = Trim(sana)
End Function - noviisi
Kunde kirjoitti:
vähän fiksummin...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Numero As String
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
Numero = HaeNumero(Range("A1"))
ActiveWorkbook.SaveAs Filename:="C:\" & Range("a1") & ".xls"
Range("A1") = "työkirja " & (Numero 1)
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End Sub
Function HaeNumero(Teksti As String)
Dim i As Integer
Dim sana As String
i = 1
Do Until sana Like (" *")
sana = Right(Teksti, i)
i = i 1
Loop
HaeNumero = Trim(sana)
End FunctionVoisinko vielä sen verran vaivata, että en osannut ottaa tuota Kunden systeemiä käyttöön...
Makroilla sain edellisen ohjeen mukaan tehtyä, mutta tätä en saanut toimimaan.
Eli minne tuo teksti pitää kopioida ja pitäisikö se pystyä liittämään toimintopainikkeeseen?
Olen tehnyt siis laskupohjan, jossa solussa B4 on laskunumero. Tuo laskunumero pitäisi saada siis juoksevaksi ja automaattisesti vaihtuvaksi (tallennettaessa). Tallennus ja tulostus tapahtuu makroon liitetyllä painikkeella. - Kunde
noviisi kirjoitti:
Voisinko vielä sen verran vaivata, että en osannut ottaa tuota Kunden systeemiä käyttöön...
Makroilla sain edellisen ohjeen mukaan tehtyä, mutta tätä en saanut toimimaan.
Eli minne tuo teksti pitää kopioida ja pitäisikö se pystyä liittämään toimintopainikkeeseen?
Olen tehnyt siis laskupohjan, jossa solussa B4 on laskunumero. Tuo laskunumero pitäisi saada siis juoksevaksi ja automaattisesti vaihtuvaksi (tallennettaessa). Tallennus ja tulostus tapahtuu makroon liitetyllä painikkeella.itselle aina niin itsestäänselvyys noi moduulit, että unohtuu mainita. Joten kopioi koodi ThisWorkook moduuliin. Et tarvitse mitään erillistä makronappulaa. Toimii ihan normaaleilla tallennusjutuilla. Nyt siis hakee A1 solusta nimen esim. työkirja 1 (pitää olla väli) ja tallentaa ja muuttaa A1 arvoksi työkirja 2 jne...
muuta A1--->> B4 niin toimii.
Jos haluat vain pelkästään numerolla tallentaa B4 mukaan niin
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
ActiveWorkbook.SaveAs Filename:="C:\" & Range("B4")& ".xls"
Range("B4") = Range("B4") 1
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End Sub - noviisi
Kunde kirjoitti:
itselle aina niin itsestäänselvyys noi moduulit, että unohtuu mainita. Joten kopioi koodi ThisWorkook moduuliin. Et tarvitse mitään erillistä makronappulaa. Toimii ihan normaaleilla tallennusjutuilla. Nyt siis hakee A1 solusta nimen esim. työkirja 1 (pitää olla väli) ja tallentaa ja muuttaa A1 arvoksi työkirja 2 jne...
muuta A1--->> B4 niin toimii.
Jos haluat vain pelkästään numerolla tallentaa B4 mukaan niin
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
ActiveWorkbook.SaveAs Filename:="C:\" & Range("B4")& ".xls"
Range("B4") = Range("B4") 1
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End SubUpeeta hei!
On se hienoa, että täältä löytyy asian osaavia ja aina vielä valmiina auttamaan. Suuret kiitokset sinulle Kunde, nyt se toimii. :-) - Bakayaro
Kunde kirjoitti:
itselle aina niin itsestäänselvyys noi moduulit, että unohtuu mainita. Joten kopioi koodi ThisWorkook moduuliin. Et tarvitse mitään erillistä makronappulaa. Toimii ihan normaaleilla tallennusjutuilla. Nyt siis hakee A1 solusta nimen esim. työkirja 1 (pitää olla väli) ja tallentaa ja muuttaa A1 arvoksi työkirja 2 jne...
muuta A1--->> B4 niin toimii.
Jos haluat vain pelkästään numerolla tallentaa B4 mukaan niin
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
ActiveWorkbook.SaveAs Filename:="C:\" & Range("B4")& ".xls"
Range("B4") = Range("B4") 1
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End SubEli itsellä olisi semmonen ongelma, että tarvis saada pohja, joka muistaa ohjelman sammutamisen jälkeen, mikä oli viimesen tiedoston numero.
Toisin sanoen pohja olisi taas "tyhjä", mutta työkirjan numero olisi se mihin jäätiin.
Tällä VBE ohjeella sain omanikin toimiin muuten, mutta se ei muista sitä viimesintä tiedoston numeroa, joten tästä ei silleen ole apua näin.
Mutta suuri kiitos, jos joku VBE tms. taitoinen pyöräyttäisi semmosen pätkän scriptiä vielä, joka saisi tuon "muistamisen" aikaan.
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
S-kauppa nosti hintoja, K-kauppa laski
Elintarvikkeiden arvonlisävero laski vuodenvaihteessa 13,5 prosenttiin. S-kauppa siirsi alennuksen suoraan katteisiin pi294958Vilma Nissinen pyytää anteeksi rasistisia lausuntojaan
Nöyrtyi kuten persut yleensäkin. On kyllä noloa tuollainen vätystely, kun ei ole miestä seisoa omien lausuntojensa takan2574708Hiihtäjä Vilma Nissisen kommentit aiheutti paniikkia
ja hernettä vedettiin nenään. Nissinen kertoi torstaina haastattelussa, kun häneltä kysyttiin, että tykkääkö hän hiihtä524405Riikka Purra: "Kokoomus haluaa leikata pienituloisten etuuksista - Se ei meille käy"
Näin vakuutti persujen Purra edellisten eduskunta vaalien alla,. https://www.ku.fi/artikkeli/4910942-kun-uudessa-videos662400Sandels tölkin hinta nousi 1,29 eurosta 1,32 euroon
Mitähän järkeä valtiolla on verottaa tuotakin elintarviketta niin kovasti, että on järkevämpää käydä hakemassa ulkomailt461828Nyt ottaa persua pattiin: sähköauto joulukuun myydyin
🤣 prööt prööt pakoputkellaan pörisevää persua ottaa nyt saamaristi pattiin, kun paristoilla kulkeva sähköauto on noussu241771Ovatko Perussuomalaiset kommunisteja?
Toiset sanovat että ovat, toiset sanovat että eivät. Ainakin heillä on paljon sen aatteen piirteitä, koska haluavat kont171738Lindtmanin pääministeriys lähenee päivä päivältä
Suomen kansan kissanpäivät alkavat siitä hetkestä, kun presidentti Stubb on tehnyt nimityksen. Ainoastaan ylin tulodesi771694Ikävä uutinen uudesta Unelmia Italiassa kaudesta - Iso pettymys tv-katsojille!
Unelmia Italiassa -sarja kertoo Ellen Jokikunnaksen perheen elämästä Suomessa ja Italiassa. Nyt Ellen on kertonut tuleva131442- 1051427