Niels28
Terugkerende gebruiker
- Lid geworden
- 20 nov 2008
- Berichten
- 2.492
Hallo,
Ik heb een userform gemaakt om een aantal gevens in excel in te vullen.
Van de gegevens in cel A1 en cel H1 wordt een map aangemaakt en een bestand in die map gekopieerd.
De gegevens van cel A1 worden automatisch ingevuld, H1 moeten mijn colegga's zelf invullen.
Omdat ze de gegevens die ze hier in moeten vullen niet altijd weten heb ik een knop op het userform gezet om de lijst waar deze gegevens instaan te openen.
Ik heb het userform op ShowModal = false gezet zodat ze in deze lijst kunnen zoeken.
De gegevens van het userform worden verwerkt als er op OKE wordt gedrukt.
Dit werkt allemaal goed behalve als ze in de andere lijst zitten.
Hoe kan ik er voor zorgen dat de macro ook werkt als ze in een andere werkmappen zijn?
Niels
Ik heb een userform gemaakt om een aantal gevens in excel in te vullen.
Van de gegevens in cel A1 en cel H1 wordt een map aangemaakt en een bestand in die map gekopieerd.
De gegevens van cel A1 worden automatisch ingevuld, H1 moeten mijn colegga's zelf invullen.
Omdat ze de gegevens die ze hier in moeten vullen niet altijd weten heb ik een knop op het userform gezet om de lijst waar deze gegevens instaan te openen.
Ik heb het userform op ShowModal = false gezet zodat ze in deze lijst kunnen zoeken.
De gegevens van het userform worden verwerkt als er op OKE wordt gedrukt.
Dit werkt allemaal goed behalve als ze in de andere lijst zitten.
Hoe kan ik er voor zorgen dat de macro ook werkt als ze in een andere werkmappen zijn?
Niels
Code:
Private Sub CommandButton1_Click()
Workbooks.Open Filename:=("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\klantnummers.xls")
End Sub
Private Sub UserForm_Activate()
TextBox1.Value = Worksheets(2).Range("A2").Value
End Sub
Private Sub OKE_Click()
'onderstaande macro uitvoeren als er op OK wordt geklikt'
'gegevens formulieren overnemen in desbetreffende cellen'
Sheets("kopieblad").Cells(1, 2).Value = Me.TextBox2.Value
Sheets("kopieblad").Cells(1, 3).Value = Me.TextBox3.Value
Sheets("kopieblad").Cells(1, 4).Value = Me.TextBox4.Value
Sheets("kopieblad").Cells(1, 5).Value = Me.TextBox5.Value
Sheets("kopieblad").Cells(1, 6).Value = Me.TextBox6.Value
Sheets("kopieblad").Cells(1, 7).Value = Me.TextBox7.Value
Sheets("kopieblad").Cells(1, 8).Value = Me.TextBox10.Value
Sheets("kopieblad").Cells(1, 9).Value = Me.TextBox8.Value
Sheets("kopieblad").Cells(1, 10).Value = Me.TextBox9.Value
Unload Me
'controleren of folder bestaat anders folder aanmaken met naam uit cel A1'
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("a1").Value & "\") Then .CreateFolder "F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("a1").Value & "\"
End With
'van cel A1 hyperlink maken'
Sheets("kopieblad").Select
Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("A1").Value & "\"
'controleren of bestand bestaat anders bestand kopieeren vanuit opgegeven folder en plakken in aangemaakte folder onder naam uit cel C16'
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists("F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("a1").Value & "\Acquisitie " & Sheets("kopieblad").Range("a1").Value & ".xls") Then FileCopy ("F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\sjabloon projecten.xls"), ("F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("a1").Value & "\Acquisitie " & Sheets("kopieblad").Range("a1").Value & ".xls")
End With
'als cel H1 leeg is macro afsluiten'
If Sheets("kopieblad").Range("H1") = "" Then GoTo Kopieëren
'controleren of folder bestaat anders folder aanmaken met naam uit cel H1'
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("H1").Value & "\") Then .CreateFolder "F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("H1").Value & "\"
End With
'van cel H1 hyperlink maken'
Sheets("kopieblad").Select
Range("H1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("H1").Value & "\"
'controleren of bestand bestaat anders bestand kopieeren vanuit opgegeven folder en plakken in aangemaakte folder onder naam uit cel C16'
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("h1").Value & "\Acquisitie " & Sheets("kopieblad").Range("h1").Value & ".xls") Then FileCopy ("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\sjabloon.xls"), ("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("h1").Value & "\Account " & Sheets("kopieblad").Range("H1").Value & ".xls")
End With
Kopieëren:
'rij 1 kopiëren van blad2'
Sheets("kopieblad").Rows("1:1").Select
Selection.Copy
'cel met opvolgend nummer zoeken en rij invoegen boven geselecteerde cel'
Sheets("overzichtslijst").Select
Cells((Range("j1").Value), 2).Select
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Select
End Sub
Private Sub CANCEL_Click()
Unload Me
End Sub