celwaarde opslaan als documentnaam

[Willempie1973]

Beste mensen,
ik zit met een probleem waar ik niet zelf meer uitkomt en hoop via deze weg tot een oplossing te komen.
vraag:
excell 2010, ik maak gebruik van calender control 11.0, dit gaat netjes, allen nu het volgende: als ik een cel (bv A1) een datum geef dan wil ik graag dat het document direct wordt opgeslagen met de naam van de datum, maar als het document al bestaat moet hij het bestaande direct openen...

ik heb het nu voor elkaar dat hij het opslaat als de datum maar als er een bestaand document met die naam is dan wordt het gewoon overschreven

is er iemand die mij uit de brand kan helpen?
met vriendelijke groet,
wim

 

[Cobbe]

Je zou toch op zijn minst de gebruikte code kunnen posten!

 

[HSV]

Kom je hiermee verder.

Sub hsv()
Dim mijnpath As String, gezochtbestand As String
  mijnpath = "D:\Map1\Map2\"
   gezochtbestand = Dir(mijnpath & "*")
 Do Until gezochtbestand = ""
    If gezochtbestand = Range("A1") & ".xlsm" Then
     Workbooks.Open mijnpath & gezochtbestand
       Exit Do
    End If
        gezochtbestand = Dir
    Loop
 If gezochtbestand = "" Then ActiveWorkbook.SaveAs mijnpath & Range("A1"), 52
End Sub

 

[omewillem]

nee, niet echt,
wat ik nu heb is het volgende:

met de volgende code op de achtergrond:

Sub opslaan()

Bestandsnaam$ = "C:\ExcelBestanden\" + Str(Range("A1").Value) + ".xls"
ActiveWorkbook.SaveAs Bestandsnaam$

End Sub

Private Sub Calendar1_Click()
    ActiveCell.Value = CDbl(Calendar1.Value)
    ActiveCell.NumberFormat = "dd/mm/yyyy"
    ActiveCell.Select
End Sub

Private Sub CommandButton1_Click()
Class Calendar

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
        Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
        Calendar1.Top = Target.Top + Target.Height
        Calendar1.Visible = True
        ' select Today's date in the Calendar
        Calendar1.Value = Date
    ElseIf Calendar1.Visible Then Calendar1.Visible = False
    End If
End Sub

nu weet ik niet welke ik moet aanpassen / vervangen met de code die u mij heeft gegeven.
gr
Wim

 

[gast0224]

Is omewillem dezelfde als TS (Willempie1973)?

 

[omewillem]

ai, ik snap wat je bedoelt,
ja dat ben ik ook????
beetje verwarrend, ik zal in het vervolg alleen nog maar met omewillem inloggen


wim

 

[HSV]

Vervang in de code eerst 'mijnpath' in de goede van jouw 'Bestandsnaam$'.
Vervang '.xlsm' door '.xls'.
Vervang de ,52 onderaan de code in & ".xls".

Laat de code eens lopen als in A1 een datum staat, en zie wat het resultaat is.
Als de code doet zo als gewenst voeg je het samen met de "Private Sub Calendar1_Click()".

 

[omewillem]

Beste Harry,
ik heb nu het volgende:

Sub opslaan()

Bestandsnaam$ = "C:\ExcelBestanden\" + Str(Range("A1").Value) + ".xls"
ActiveWorkbook.SaveAs Bestandsnaam$

End Sub

Sub hsv()
Dim mijnpath As String, gezochtbestand As String
  mijnpath = "C:\ExcelBestanden\"
   gezochtbestand = Dir(mijnpath & "*")
 Do Until gezochtbestand = ""
    If gezochtbestand = Range("A1") & ".xls" Then
     Workbooks.Open mijnpath & gezochtbestand
       Exit Do
    End If
        gezochtbestand = Dir
    Loop
 If gezochtbestand = "" Then ActiveWorkbook.SaveAs mijnpath & Range("A1"), ".xls"
End Sub
Private Sub Calendar1_Click()
    ActiveCell.Value = CDbl(Calendar1.Value)
    ActiveCell.NumberFormat = "dd/mm/yyyy"
    ActiveCell.Select
End Sub

Private Sub CommandButton1_Click()
Class Calendar

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
        Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
        Calendar1.Top = Target.Top + Target.Height
        Calendar1.Visible = True
        ' select Today's date in the Calendar
        Calendar1.Value = Date
    ElseIf Calendar1.Visible Then Calendar1.Visible = False
    End If
End Sub

als ik nu op invoeren bestelling klik dan krijg ik de volgende melding:


ik ben echt een beginnende VBA leerling, dus sorrie als ik het niet in een keer snap of begrijp, in elkgeval veel dank voor de tot nu geboden hulp.

gr

Wim
ps ik weet ook niet hoe ik de code in een zelfde vakje kan krijgen als jullie hier op het forum(zie uw aan mijn gepresenteerde code)

 

[HSV]

Welke code hangt er aan de knop.
Sub hsv() of sub opslaan()

Ps: selecteer je code en druk op het hekje (#).
Nu staat het tussen codetags.

Verander in je code:

If gezochtbestand = "" Then ActiveWorkbook.SaveAs mijnpath & [COLOR="#FF0000"]Range("A1"), ".xls"[/COLOR]

If gezochtbestand = "" Then ActiveWorkbook.SaveAs mijnpath & [COLOR="#FF0000"]Range("A1") & ".xls"[/COLOR]

 

[omewillem]

ok, misschien makkelijker als ik het bestandje naar u mail?
nu hangt Sub opslaan() aan de knop

 

[HSV]

Dat dacht ik al.

En wat gebeurd er als je mijn code aan een ander knop hangt?
Je bestand kan je hier ook neerzetten toch?

 

[omewillem]

Bekijk bijlage 28-Dec-11.xls
ok, dat is beter
als ik het & teken erbij plaats dan krijg ik direct een foutmelding

 

[HSV]

Dit moet gewoon werken.

Sub hsv()
Dim mijnpath As String, gezochtbestand As String
  mijnpath = "C:\ExcelBestanden\"
   gezochtbestand = Dir(mijnpath & "*")
 Do Until gezochtbestand = ""
    If gezochtbestand = Range("A1") & ".xls" Then
     Workbooks.Open mijnpath & gezochtbestand
       Exit Do
    End If
        gezochtbestand = Dir
    Loop
 If gezochtbestand = "" Then ActiveWorkbook.SaveAs mijnpath & Range("A1") & ".xls"
End Sub

 

[omewillem]

sorrie Harry,

het heeft lang geduurt met my,
dank voor de gebode hulp, probleem is nu opgelost en werkt prima.
ik ben met een nieuw doc begonnen en nu geen foutmeldingen meer.


gr

wim