W Bloemendal
Gebruiker
- Lid geworden
- 28 jan 2001
- Berichten
- 503
Hallo
ik heb een macro met een invulbox(zie onderstaande macro)
nu is mijn vraag of ik de invulbox kan krijgen met een keuze lijst.
wim
Sub boren()
Application.ScreenUpdating = False
Dim BLAD As String
Dim i As Integer
Dim X As Integer
Dim Machnr As String
Dim zoek As String
Dim Y As Integer
Dim GEVONDEN As Boolean
If ActiveWindow.RangeSelection.Columns.Count = 256 And ActiveWindow.RangeSelection.Cells.Count = 256 Then
aantal = "9"
Y = InputBox("geef Machine nr", "Machine")
If Y < 1 Or Y > 9 Then MsgBox "Geen goede Machine nr", vbExclamation: End
Machnr = "Machine" & Y
For i = 1 To 2
If i = 1 Then BLAD = "boorlijst"
If i = 2 Then BLAD = "UITGEGEVEN"
Sheets(BLAD).Select
ActiveSheet.Unprotect
Next i
Selection.Copy
Application.Goto Reference:=Machnr
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
Sheets("UITGEGEVEN").Select
Selection.Delete Shift:=xlUp
Sheets("Boorlijst").Select
For X = 1 To 2
If X = 1 Then BLAD = "boorlijst"
If X = 2 Then BLAD = "UITGEGEVEN"
Sheets(BLAD).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select
Next X
Else
MsgBox "Geen goede selectie", vbExclamation
End If
ik heb een macro met een invulbox(zie onderstaande macro)
nu is mijn vraag of ik de invulbox kan krijgen met een keuze lijst.
wim
Sub boren()
Application.ScreenUpdating = False
Dim BLAD As String
Dim i As Integer
Dim X As Integer
Dim Machnr As String
Dim zoek As String
Dim Y As Integer
Dim GEVONDEN As Boolean
If ActiveWindow.RangeSelection.Columns.Count = 256 And ActiveWindow.RangeSelection.Cells.Count = 256 Then
aantal = "9"
Y = InputBox("geef Machine nr", "Machine")
If Y < 1 Or Y > 9 Then MsgBox "Geen goede Machine nr", vbExclamation: End
Machnr = "Machine" & Y
For i = 1 To 2
If i = 1 Then BLAD = "boorlijst"
If i = 2 Then BLAD = "UITGEGEVEN"
Sheets(BLAD).Select
ActiveSheet.Unprotect
Next i
Selection.Copy
Application.Goto Reference:=Machnr
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
Sheets("UITGEGEVEN").Select
Selection.Delete Shift:=xlUp
Sheets("Boorlijst").Select
For X = 1 To 2
If X = 1 Then BLAD = "boorlijst"
If X = 2 Then BLAD = "UITGEGEVEN"
Sheets(BLAD).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select
Next X
Else
MsgBox "Geen goede selectie", vbExclamation
End If
Laatst bewerkt: