Solujen kiinnitys toisiinsa

Oli hiukan tarvettava vastaavanlaiselle itselläkin, mutta tarvitsin sen tekstitietoon kirjoittamaan kuten lokitiedosto...

kalenterista valitaan päiväys ja tuo tekstiruutun tekstin, jos sille päivälle on kirjoitettu jotakin. Kirjoita napilla kirjoittaa sitten yakaisin tiedostoon tekstiruudun tekstin- eli päivitää sen päivän tekstit ja jos ei ole ko. päivälle tekstiä lisää sen tiedostoon- eli täysin muokattava tiedosto...

muokkasin tota yhdestä vanhasta postauksestani tänne vuosien takaa, nyt siis tiedosto näyttää tältä
esim. $212011 tarkoittaa 2.1.2001 pvm ja sen alla sitten kirjoitettu teksti. Koodi perustuu tohon dollaripäiväykseen ja helposti muokattavissa omiin tarpeisiin.

$212011
kukkuluuruu toimiiko?
$312011
hyvin toimii
$412011
uutta lisättyä
tietoa
pukkaa
$512011
lisätään tietoa
$612011
vielä
kerta
$712011
kiellon
$812011
päälle


lisää lomake ja siihen

2 commandbuttonia (Lopeta ja Kirjoita)
1 Calendar control i(jos ei oo työkaluvalikossa, klikkaa hiiren oikealla työvalikkoa ja lisää kontrolleja ja selaa ja valitse Calendar Control XX)
1 textbox

muuta polku ja tiedoston nimi sopivaksi

lomakkeen koodit oletusnimillä...

Option Explicit
Dim X As String

Private Sub Calendar1_Click()
Me.TextBox1 = LueTekstiFile("d:\Päiväkirja.txt", "$" & Replace(Calendar1.Value, ".", ""))
End Sub

Private Sub CommandButton1_Click()
End
End Sub

Private Sub CommandButton2_Click()
X = LueTekstiFile("d:\Päiväkirja.txt", "$" & Replace(Calendar1.Value, ".", ""))
If X = "" Then
KirjoitaTekstiFile "d:\Päiväkirja.txt", "$" & Replace(Calendar1.Value, ".", ""), "$" & Replace(Calendar1.Value, ".", "") & vbNewLine & Me.TextBox1, True
Else
KirjoitaTekstiFile "d:\Päiväkirja.txt", X, Me.TextBox1, False
End If
End Sub

textboxin ominaisuuksissa

EnterKeyBehavior=TRUE
WorldWrap=TRUE
Multiline=TRUE

normaali moduuliin...

Option Explicit
Function LueTekstiFile(TekstiFile As String, Alkurivi As String) As Variant

Dim Dollarimerkki As String
Dim Teksti As String
Dim Rivimäärä As Long
Dim Dollariteksti As Boolean
Dim Pituus As Long
Dim Tarkiste As Long
Dim Omatarkiste As Long
Dim Viesti As String

On Error GoTo virhe
Dollarimerkki = "*" & Alkurivi & "*"
Open TekstiFile For Input As #1
Do While Not EOF(1)
Line Input #1, Teksti
If Teksti Like Dollarimerkki Then
Dollariteksti = True
End If

If Dollariteksti = True Then
If Teksti = Alkurivi Then GoTo hyppy
If Teksti Like "*$*" Then GoTo loppu
LueTekstiFile = LueTekstiFile & Teksti & vbNewLine
End If
hyppy:
Loop
loppu:
Close #1
virhepoistu:
Exit Function
virhe:
Close #1
Viesti = Err.Description & " " & Err.Number
MsgBox Viesti, vbCritical, "Tiedostosta luku"
Resume virhepoistu
End Function

Sub KirjoitaTekstiFile(TekstiFile As String, Etsi As String, Korvaa As String, Lisää As Boolean)

Dim SeuraavaVapaa As Long
Dim VanhaTeksti As String
Dim UusiTeksti As String

SeuraavaVapaa = FreeFile
If Lisää Then
Open TekstiFile For Append As SeuraavaVapaa
Print #SeuraavaVapaa, Korvaa
Close #SeuraavaVapaa
Else
Open TekstiFile For Input As SeuraavaVapaa
VanhaTeksti = Input$(LOF(SeuraavaVapaa), SeuraavaVapaa)
Close SeuraavaVapaa

UusiTeksti = Replace(VanhaTeksti, Etsi, Korvaa)
SeuraavaVapaa = FreeFile

Open TekstiFile For Output As SeuraavaVapaa
Print #SeuraavaVapaa, UusiTeksti & vbNewLine
Close #SeuraavaVapaa
End If
End Sub

Keep EXCELing
@Kunde