Posts: 72
Threads: 13
Joined: Apr 2022
Reputation:
9
I changed it so that the number of words is automatic - you do not have to tell it in advance. Once you press ENTER with a null word it assumes you are done and creates the puzzle. Also all words are capitalized.
Code: (Select All)
'Word Search Maker by SierraKen
'April 1, 2025
'With some help by ChatGPT. I was very close by myself, all of the math and arrays are from me, just needed it cleaned up a bit.
'Thank you to B+ for the graphics rotation code to print on printer.
Dim word$(24), grid$(18, 18)
Screen _NewImage(800, 600, 32)
_Title "Word Search Maker - P to Print on Printer C to Clipboard Space Bar For Another One Esc to Quit"
begin:
t = 0: num = 0: w = 0
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print " Word Search Maker"
Print " by SierraKen"
Print: Print: Print
Print " P to Print on Printer."
Print " C to Copy to Clipboard to use with another graphics program."
Print " Space Bar for another one."
Print " Esc to Quit."
Print
Print " Words cannot be over 15 letters long."
Print
'Input " How many words (1-24): ", num
'If num > 24 Or num < 1 Or num <> Int(num) Then GoTo begin
'Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print " Type one word at a time here for your puzzle. Only large letters are used:"
Print
GetNextWord:
w = w + 1
words:
Print Str$(w) + ". ";
Input word$(w)
word$(w) = UCase$(_Trim$(word$(w)))
If Len(word$(w)) > 15 Then Print " Words cannot be over 15 letters long.": Print: GoTo words
temp$ = ""
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) <> " " Then temp$ = temp$ + Mid$(word$(w), ii, 1)
Next ii
If temp$ <> "" Then word$(w) = temp$ ' Only assign if temp$ changed
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) < Chr$(65) Or Mid$(word$(w), ii, 1) > Chr$(90) Then
Print " Only large letters used.": GoTo words
End If
Next ii
If word$(w) = "" Then
If w = 1 Then System
num = w
GoTo DoneInput
End If
If w = 24 GoTo DoneInput
GoTo GetNextWord
DoneInput:
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
' Initialize grid
For y = 1 To 18
For x = 1 To 18
grid$(y, x) = ""
Next x
Next y
Randomize Timer
For w = 1 To num
placement:
t = t + 1
If t > 2000 Then
Print word$(w) + " unable to work with this puzzle, press Enter to start over."
Input ab$
t = 0
GoTo begin
End If
dir = Int(Rnd * 8) + 1
x = Int(Rnd * 18) + 1: y = Int(Rnd * 18) + 1
' Ensure the word fits in the selected direction
If dir = 1 And x + Len(word$(w)) > 18 Then GoTo placement ' Right
If dir = 2 And x - Len(word$(w)) < 1 Then GoTo placement ' Left
If dir = 3 And y + Len(word$(w)) > 18 Then GoTo placement ' Down
If dir = 4 And y - Len(word$(w)) < 1 Then GoTo placement ' Up
If dir = 5 And (x + Len(word$(w)) > 18 Or y + Len(word$(w)) > 18) Then GoTo placement ' Right-Down
If dir = 6 And (x - Len(word$(w)) < 1 Or y + Len(word$(w)) > 18) Then GoTo placement ' Left-Down
If dir = 7 And (x - Len(word$(w)) < 1 Or y - Len(word$(w)) < 1) Then GoTo placement ' Left-Up
If dir = 8 And (x + Len(word$(w)) > 18 Or y - Len(word$(w)) < 1) Then GoTo placement ' Right-Up
' Check for conflicts
For l = 1 To Len(word$(w))
cx = x: cy = y
If dir = 1 Then cx = x + l ' Right
If dir = 2 Then cx = x - l ' Left
If dir = 3 Then cy = y + l ' Down
If dir = 4 Then cy = y - l ' Up
If dir = 5 Then cx = x + l: cy = y + l ' Right-Down
If dir = 6 Then cx = x - l: cy = y + l ' Left-Down
If dir = 7 Then cx = x - l: cy = y - l ' Left-Up
If dir = 8 Then cx = x + l: cy = y - l ' Right-Up
If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement
Next l
' Place word
For l = 1 To Len(word$(w))
cx = x: cy = y
If dir = 1 Then cx = x + l ' Right
If dir = 2 Then cx = x - l ' Left
If dir = 3 Then cy = y + l ' Down
If dir = 4 Then cy = y - l ' Up
If dir = 5 Then cx = x + l: cy = y + l ' Right-Down
If dir = 6 Then cx = x - l: cy = y + l ' Left-Down
If dir = 7 Then cx = x - l: cy = y - l ' Left-Up
If dir = 8 Then cx = x + l: cy = y - l ' Right-Up
grid$(cy, cx) = Mid$(word$(w), l, 1)
Next l
t = 0
Next w
' Fill empty spaces with random letters
For y = 1 To 18
For x = 1 To 18
If grid$(y, x) = "" Then grid$(y, x) = Chr$(Int(Rnd * 26) + 65)
Next x
Next y
' Display grid with spaces between letters
For y = 1 To 18
For x = 1 To 18
Locate y + 5, (x * 2) + 30: Print grid$(y, x); " ";
Next x
Print
Next y
listx = 15: listy = 25
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print word$(l)
Next l
Do
a$ = InKey$
If a$ = "c" Or a$ = "C" Then
landscape2& = _CopyImage(0)
_ClipboardImage = landscape2&
For sz = 0 To 20
Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 0, 0), B
Next sz
_Delay 4
For sz = 0 To 20
Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B
Next sz
_FreeImage landscape2&
End If
If a$ = "p" Or a$ = "P" Then
'printer prep (code from bplus Free Calendar Program)
YMAX = _Height: XMAX = _Width
landscape& = _NewImage(YMAX, XMAX, 32)
_MapTriangle (XMAX, 0)-(0, 0)-(0, YMAX), 0 To(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
_MapTriangle (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 To(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
_PrintImage landscape&
_Delay 2
_FreeImage landscape&
End If
If a$ = " " Then GoTo begin
If a$ = Chr$(27) Then End
Loop
Posts: 629
Threads: 113
Joined: Apr 2022
Reputation:
48
04-23-2025, 05:03 AM
(This post was last modified: 04-23-2025, 05:05 AM by SierraKen.)
Thanks Dano, but mine also converts all small letters to large ones. You might have used an older post than the newest one, not sure. But that's pretty neat how it doesn't need a number of words first. Good job.
-Ken
Posts: 629
Threads: 113
Joined: Apr 2022
Reputation:
48
Today I decided to add a shift to the list of words at the bottom so they are centered better for any amount.
Code: (Select All)
'Word Search Maker by SierraKen
'May 6, 2025
'With some help by ChatGPT. I was very close by myself, all of the math and arrays are from me, just needed it cleaned up a bit.
'Thank you to B+ for the graphics rotation code to print on printer and also for the idea of seeing the answers to the words.
'Thank you also to PhilofPerth for the idea of still using small letters and converting them to large. Also for using letters instead of numbers on the answers selections.
'Also, thank you PhilofPerth for the idea of putting the instructions on the main page.
'Update: Shifted list of words at the bottom so they are right under the puzzle and centered better for any amount.
Dim word$(24), grid$(18, 18), dir(24), x(24), y(24)
Screen _NewImage(800, 600, 32)
_Title "Word Search Maker - by SierraKen"
begin:
t = 0: num = 0
For a = 1 To 24
word$(a) = ""
Next a
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print " Word Search Maker"
Print " by SierraKen"
Print: Print: Print
Print " A to see an Answer to a Word."
Print " P to Print on Printer."
Print " C to Copy to Clipboard to use with another graphics program."
Print " Space Bar for another one."
Print " Esc to Quit."
Print
Print " Words cannot be over 15 letters long."
Print
Input " How many words (1-24): ", num
If num > 24 Or num < 1 Or num <> Int(num) Then GoTo begin
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print " Type one word at a time here for your puzzle."
Print
For w = 1 To num
words:
Print Str$(w) + ". ";
Input word$(w)
If Len(word$(w)) > 15 Then Print " Words cannot be over 15 letters long.": Print: GoTo words
temp$ = ""
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) <> " " Then temp$ = temp$ + Mid$(word$(w), ii, 1)
Next ii
If temp$ <> "" Then word$(w) = temp$ ' Only assign if temp$ changed
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) < Chr$(65) Or (Mid$(word$(w), ii, 1) > Chr$(90) And Mid$(word$(w), ii, 1) < Chr$(97)) Then
Print " No numbers or symbols, try again.": GoTo words
End If
Next ii
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) > Chr$(122) Then
Print " No numbers or symbols, try again.": GoTo words
End If
Next ii
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) > Chr$(96) Or Mid$(word$(w), ii, 1) < Chr$(123) Then
word$(w) = UCase$(word$(w))
End If
Next ii
Next w
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
' Initialize grid
For y = 1 To 18
For x = 1 To 18
grid$(y, x) = ""
Next x
Next y
Randomize Timer
For w = 1 To num
placement:
t = t + 1
If t > 2000 Then
Print word$(w) + " unable to work with this puzzle, press Enter to start over."
Input ab$
t = 0
GoTo begin
End If
dir(w) = Int(Rnd * 8) + 1
x(w) = Int(Rnd * 18) + 1: y(w) = Int(Rnd * 18) + 1
' Ensure the word fits in the selected direction
If dir(w) = 1 And x(w) + Len(word$(w)) > 18 Then GoTo placement ' Right
If dir(w) = 2 And x(w) - Len(word$(w)) < 1 Then GoTo placement ' Left
If dir(w) = 3 And y(w) + Len(word$(w)) > 18 Then GoTo placement ' Down
If dir(w) = 4 And y(w) - Len(word$(w)) < 1 Then GoTo placement ' Up
If dir(w) = 5 And (x(w) + Len(word$(w)) > 18 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Right-Down
If dir(w) = 6 And (x(w) - Len(word$(w)) < 1 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Left-Down
If dir(w) = 7 And (x(w) - Len(word$(w)) < 1 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Left-Up
If dir(w) = 8 And (x(w) + Len(word$(w)) > 18 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Right-Up
' Check for conflicts
For l = 1 To Len(word$(w))
cx = x(w): cy = y(w)
If dir(w) = 1 Then cx = x(w) + l ' Right
If dir(w) = 2 Then cx = x(w) - l ' Left
If dir(w) = 3 Then cy = y(w) + l ' Down
If dir(w) = 4 Then cy = y(w) - l ' Up
If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down
If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down
If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up
If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up
If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement
Next l
' Place word
For l = 1 To Len(word$(w))
cx = x(w): cy = y(w)
If dir(w) = 1 Then cx = x(w) + l ' Right
If dir(w) = 2 Then cx = x(w) - l ' Left
If dir(w) = 3 Then cy = y(w) + l ' Down
If dir(w) = 4 Then cy = y(w) - l ' Up
If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down
If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down
If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up
If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up
grid$(cy, cx) = Mid$(word$(w), l, 1)
Next l
t = 0
Next w
' Fill empty spaces with random letters
For y = 1 To 18
For x = 1 To 18
If grid$(y, x) = "" Then grid$(y, x) = Chr$(Int(Rnd * 26) + 65)
Next x
Next y
' Display grid with spaces between letters
For y = 1 To 18
For x = 1 To 18
Locate y + 5, (x * 2) + 30: Print grid$(y, x); " ";
Next x
Print
Next y
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print word$(l)
Next l
Locate 1, 15: Print "(A)nswer | (P)rint | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
Do
a$ = InKey$
If a$ = "a" Or a$ = "A" Then GoSub answers
If a$ = "c" Or a$ = "C" Then
Locate 1, 15: Print " "
_Delay .1
landscape2& = _CopyImage(0)
_ClipboardImage = landscape2&
For sz = 0 To 20
Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 0, 0), B
Next sz
_Delay 2
For sz = 0 To 20
Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B
Next sz
_FreeImage landscape2&
Locate 1, 15: Print "(A)nswer | (P)rint | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
End If
If a$ = "p" Or a$ = "P" Then
Locate 1, 15: Print " "
_Delay .1
'printer prep (code from bplus Free Calendar Program)
YMAX = _Height: XMAX = _Width
landscape& = _NewImage(YMAX, XMAX, 32)
_MapTriangle (XMAX, 0)-(0, 0)-(0, YMAX), 0 To(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
_MapTriangle (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 To(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
_PrintImage landscape&
_Delay 2
_FreeImage landscape&
Locate 1, 15: Print "(A)nswer | (P)rint | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
End If
If a$ = " " Then GoTo begin
If a$ = Chr$(27) Then End
Loop
answers:
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print "(" + Chr$(96 + l) + ") " + word$(l)
Next l
Locate 23, 5: Print "Which word letter?"
Do
pick:
n$ = InKey$
If n$ <> "" Then
If n$ = "a" Or n$ = "A" Then n = 1
If n$ = "b" Or n$ = "B" Then n = 2
If n$ = "c" Or n$ = "C" Then n = 3
If n$ = "d" Or n$ = "D" Then n = 4
If n$ = "e" Or n$ = "E" Then n = 5
If n$ = "f" Or n$ = "F" Then n = 6
If n$ = "g" Or n$ = "G" Then n = 7
If n$ = "h" Or n$ = "H" Then n = 8
If n$ = "i" Or n$ = "I" Then n = 9
If n$ = "j" Or n$ = "J" Then n = 10
If n$ = "k" Or n$ = "K" Then n = 11
If n$ = "l" Or n$ = "L" Then n = 12
If n$ = "m" Or n$ = "M" Then n = 13
If n$ = "n" Or n$ = "N" Then n = 14
If n$ = "o" Or n$ = "O" Then n = 15
If n$ = "p" Or n$ = "P" Then n = 16
If n$ = "q" Or n$ = "Q" Then n = 17
If n$ = "r" Or n$ = "R" Then n = 18
If n$ = "s" Or n$ = "S" Then n = 19
If n$ = "t" Or n$ = "T" Then n = 20
If n$ = "u" Or n$ = "U" Then n = 21
If n$ = "v" Or n$ = "V" Then n = 22
If n$ = "w" Or n$ = "W" Then n = 23
If n$ = "x" Or n$ = "X" Then n = 24
If word$(n) = "" Then GoTo pick
GoTo nex
End If
Loop
nex:
For l = 1 To Len(word$(n))
cx = x(n): cy = y(n)
Select Case dir(n)
Case 1: cx = x(n) + l ' Right
Case 2: cx = x(n) - l ' Left
Case 3: cy = y(n) + l ' Down
Case 4: cy = y(n) - l ' Up
Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down
Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down
Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up
Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up
End Select
Locate cy + 5, (cx * 2) + 30
Color _RGB32(255, 0, 0)
Print grid$(cy, cx);
Next l
_Delay 5
For l = 1 To Len(word$(n))
cx = x(n): cy = y(n)
Select Case dir(n)
Case 1: cx = x(n) + l ' Right
Case 2: cx = x(n) - l ' Left
Case 3: cy = y(n) + l ' Down
Case 4: cy = y(n) - l ' Up
Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down
Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down
Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up
Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up
End Select
Locate cy + 5, (cx * 2) + 30
Color _RGB32(0, 0, 0)
Print grid$(cy, cx);
Next l
Locate 23, 5: Print " "
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print " "
Locate listy, listx: Print word$(l)
Next l
n = 0
n$ = ""
Return
Posts: 629
Threads: 113
Joined: Apr 2022
Reputation:
48
I decided to add the ability to save your puzzles as a JPG file to your local directory where you have this program.
When you press S to save it, an Input Box will pop up and you can type a name and press OK and then a Message Box will come up saying it's saved and where.
I also added a title name to display on your puzzle if you want. If you don't want one you can just press Enter where it asks for one.
One trick I figured out by myself recently was how to center text to the screen. Today I made it even easier with just 1 line of code:
nm$ would be the words you want centered and 30 is just the vertical number I chose for the heading.
Code: (Select All)
_PrintString ((_Width / 2) - ((Len(nm$) * 8) / 2), 30), nm$ 'Centers nm$ horizontally
If you want a word directly in the middle of the screen, horizontal and vertical, you can do this:
Code: (Select All)
_PrintString ((_Width / 2) - ((Len(nm$) * 8) / 2), ((_Height / 2)), nm$ 'Centers nm$ horizontally and vertically.
Here is the new update, enjoy!
Code: (Select All)
'Word Search Maker by SierraKen
'May 17, 2025
'With some help by ChatGPT. I was very close by myself, all of the math and arrays are from me, just needed it cleaned up a bit.
'Thank you to B+ for the graphics rotation code to print on printer and also for the idea of seeing the answers to the words.
'Thank you also to PhilofPerth for the idea of still using small letters and converting them to large. Also for using letters instead of numbers on the answers selections.
'Also, thank you PhilofPerth for the idea of putting the instructions on the main page.
'Update: Shifted list of words at the bottom so they are right under the puzzle and centered better for any amount.
'Update: Added ability to save as JPG picture. Also added a title displayed on your puzzle.
Dim word$(24), grid$(18, 18), dir(24), x(24), y(24)
Screen _NewImage(800, 600, 32)
_Title "Word Search Maker - by SierraKen"
begin:
t = 0: num = 0
For a = 1 To 24
word$(a) = ""
Next a
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print " Word Search Maker"
Print " by SierraKen"
Print: Print: Print
Print " Instructions"
Print " ------------"
Print
Print " A to see an Answer to a Word."
Print " P to Print on Printer."
Print " S to Save as JPG picture."
Print " C to Copy to Clipboard to use with another graphics program."
Print " Space Bar for another one."
Print " Esc to Quit."
Print
Print " Words cannot be over 15 letters long."
Print
Input " New title name to display (Just press Enter for no title.): ", nm$
Print
Input " How many words (1-24): ", num
If num > 24 Or num < 1 Or num <> Int(num) Then GoTo begin
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print " Type one word at a time here for your puzzle."
Print
For w = 1 To num
words:
Print Str$(w) + ". ";
Input word$(w)
If Len(word$(w)) > 15 Then Print " Words cannot be over 15 letters long.": Print: GoTo words
temp$ = ""
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) <> " " Then temp$ = temp$ + Mid$(word$(w), ii, 1)
Next ii
If temp$ <> "" Then word$(w) = temp$ ' Only assign if temp$ changed
If word$(w) = "" Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Then
Print " Nothing typed, try again."
GoTo words
End If
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) < Chr$(65) Or (Mid$(word$(w), ii, 1) > Chr$(90) And Mid$(word$(w), ii, 1) < Chr$(97)) Then
Print " No numbers or symbols, try again.": GoTo words
End If
Next ii
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) > Chr$(122) Then
Print " No numbers or symbols, try again.": GoTo words
End If
Next ii
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) > Chr$(96) Or Mid$(word$(w), ii, 1) < Chr$(123) Then
word$(w) = UCase$(word$(w))
End If
Next ii
Next w
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
' Initialize grid
For y = 1 To 18
For x = 1 To 18
grid$(y, x) = ""
Next x
Next y
_PrintString ((_Width / 2) - ((Len(nm$) * 8) / 2), 30), nm$ 'Centers nm$
Randomize Timer
For w = 1 To num
placement:
t = t + 1
If t > 2000 Then
Print word$(w) + " unable to work with this puzzle, press Enter to start over."
Input ab$
t = 0
GoTo begin
End If
dir(w) = Int(Rnd * 8) + 1
x(w) = Int(Rnd * 18) + 1: y(w) = Int(Rnd * 18) + 1
' Ensure the word fits in the selected direction
If dir(w) = 1 And x(w) + Len(word$(w)) > 18 Then GoTo placement ' Right
If dir(w) = 2 And x(w) - Len(word$(w)) < 1 Then GoTo placement ' Left
If dir(w) = 3 And y(w) + Len(word$(w)) > 18 Then GoTo placement ' Down
If dir(w) = 4 And y(w) - Len(word$(w)) < 1 Then GoTo placement ' Up
If dir(w) = 5 And (x(w) + Len(word$(w)) > 18 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Right-Down
If dir(w) = 6 And (x(w) - Len(word$(w)) < 1 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Left-Down
If dir(w) = 7 And (x(w) - Len(word$(w)) < 1 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Left-Up
If dir(w) = 8 And (x(w) + Len(word$(w)) > 18 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Right-Up
' Check for conflicts
For l = 1 To Len(word$(w))
cx = x(w): cy = y(w)
If dir(w) = 1 Then cx = x(w) + l ' Right
If dir(w) = 2 Then cx = x(w) - l ' Left
If dir(w) = 3 Then cy = y(w) + l ' Down
If dir(w) = 4 Then cy = y(w) - l ' Up
If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down
If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down
If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up
If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up
If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement
Next l
' Place word
For l = 1 To Len(word$(w))
cx = x(w): cy = y(w)
If dir(w) = 1 Then cx = x(w) + l ' Right
If dir(w) = 2 Then cx = x(w) - l ' Left
If dir(w) = 3 Then cy = y(w) + l ' Down
If dir(w) = 4 Then cy = y(w) - l ' Up
If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down
If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down
If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up
If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up
grid$(cy, cx) = Mid$(word$(w), l, 1)
Next l
t = 0
Next w
' Fill empty spaces with random letters
For y = 1 To 18
For x = 1 To 18
If grid$(y, x) = "" Then grid$(y, x) = Chr$(Int(Rnd * 26) + 65)
Next x
Next y
' Display grid with spaces between letters
For y = 1 To 18
For x = 1 To 18
Locate y + 5, (x * 2) + 31: Print grid$(y, x); " ";
Next x
Print
Next y
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print word$(l)
Next l
Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
Do
a$ = InKey$
If a$ = "a" Or a$ = "A" Then GoSub answers
If a$ = "s" Or a$ = "S" Then GoSub saving
If a$ = "c" Or a$ = "C" Then
Locate 1, 15: Print " "
_Delay .1
landscape2& = _CopyImage(0)
_ClipboardImage = landscape2&
For sz = 0 To 20
Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 0, 0), B
Next sz
_Delay 2
For sz = 0 To 20
Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B
Next sz
_FreeImage landscape2&
Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
End If
If a$ = "p" Or a$ = "P" Then
Locate 1, 15: Print " "
_Delay .1
'printer prep (code from bplus Free Calendar Program)
YMAX = _Height: XMAX = _Width
landscape& = _NewImage(YMAX, XMAX, 32)
_MapTriangle (XMAX, 0)-(0, 0)-(0, YMAX), 0 To(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
_MapTriangle (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 To(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
_PrintImage landscape&
_Delay 2
_FreeImage landscape&
Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
End If
If a$ = " " Then GoTo begin
If a$ = Chr$(27) Then End
Loop
answers:
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print "(" + Chr$(96 + l) + ") " + word$(l)
Next l
Locate 23, 5: Print "Which word letter?"
Do
pick:
n$ = InKey$
If n$ <> "" Then
If n$ = "a" Or n$ = "A" Then n = 1
If n$ = "b" Or n$ = "B" Then n = 2
If n$ = "c" Or n$ = "C" Then n = 3
If n$ = "d" Or n$ = "D" Then n = 4
If n$ = "e" Or n$ = "E" Then n = 5
If n$ = "f" Or n$ = "F" Then n = 6
If n$ = "g" Or n$ = "G" Then n = 7
If n$ = "h" Or n$ = "H" Then n = 8
If n$ = "i" Or n$ = "I" Then n = 9
If n$ = "j" Or n$ = "J" Then n = 10
If n$ = "k" Or n$ = "K" Then n = 11
If n$ = "l" Or n$ = "L" Then n = 12
If n$ = "m" Or n$ = "M" Then n = 13
If n$ = "n" Or n$ = "N" Then n = 14
If n$ = "o" Or n$ = "O" Then n = 15
If n$ = "p" Or n$ = "P" Then n = 16
If n$ = "q" Or n$ = "Q" Then n = 17
If n$ = "r" Or n$ = "R" Then n = 18
If n$ = "s" Or n$ = "S" Then n = 19
If n$ = "t" Or n$ = "T" Then n = 20
If n$ = "u" Or n$ = "U" Then n = 21
If n$ = "v" Or n$ = "V" Then n = 22
If n$ = "w" Or n$ = "W" Then n = 23
If n$ = "x" Or n$ = "X" Then n = 24
If word$(n) = "" Then GoTo pick
GoTo nex
End If
Loop
nex:
For l = 1 To Len(word$(n))
cx = x(n): cy = y(n)
Select Case dir(n)
Case 1: cx = x(n) + l ' Right
Case 2: cx = x(n) - l ' Left
Case 3: cy = y(n) + l ' Down
Case 4: cy = y(n) - l ' Up
Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down
Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down
Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up
Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up
End Select
Locate cy + 5, (cx * 2) + 30
Color _RGB32(255, 0, 0)
Print grid$(cy, cx);
Next l
_Delay 5
For l = 1 To Len(word$(n))
cx = x(n): cy = y(n)
Select Case dir(n)
Case 1: cx = x(n) + l ' Right
Case 2: cx = x(n) - l ' Left
Case 3: cy = y(n) + l ' Down
Case 4: cy = y(n) - l ' Up
Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down
Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down
Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up
Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up
End Select
Locate cy + 5, (cx * 2) + 30
Color _RGB32(0, 0, 0)
Print grid$(cy, cx);
Next l
Locate 23, 5: Print " "
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print " "
Locate listy, listx: Print word$(l)
Next l
n = 0
n$ = ""
Return
saving:
name$ = _InputBox$("Save", "Type a name of file to save without jpg ending.")
If name$ = "" Then GoTo saving
name$ = name$ + ".jpg"
Locate 1, 11: Print " "
_SaveImage name$
path$ = _FullPath$(name$)
_MessageBox "Saved", "Puzzle picture saved as " + name$ + " to " + path$
Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
Return
Posts: 629
Threads: 113
Joined: Apr 2022
Reputation:
48
I decided to add a limit to the length of the title, so it doesn't go off the screen. It's less than 100 letters, numbers, symbols, and spaces.
Code: (Select All)
'Word Search Maker by SierraKen
'May 17, 2025 - 2
'With some help by ChatGPT. I was very close by myself, all of the math and arrays are from me, just needed it cleaned up a bit.
'Thank you to B+ for the graphics rotation code to print on printer and also for the idea of seeing the answers to the words.
'Thank you also to PhilofPerth for the idea of still using small letters and converting them to large. Also for using letters instead of numbers on the answers selections.
'Also, thank you PhilofPerth for the idea of putting the instructions on the main page.
'Update: Shifted list of words at the bottom so they are right under the puzzle and centered better for any amount.
'Update: Added ability to save as JPG picture. Also added a title displayed on your puzzle.
'Update: Added limit to length of title.
Dim word$(24), grid$(18, 18), dir(24), x(24), y(24)
Screen _NewImage(800, 600, 32)
_Title "Word Search Maker - by SierraKen"
begin:
t = 0: num = 0
For a = 1 To 24
word$(a) = ""
Next a
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print " Word Search Maker"
Print " by SierraKen"
Print: Print: Print
Print " Instructions"
Print " ------------"
Print
Print " A to see an Answer to a Word."
Print " P to Print on Printer."
Print " S to Save as JPG picture."
Print " C to Copy to Clipboard to use with another graphics program."
Print " Space Bar for another one."
Print " Esc to Quit."
Print
Print " Words cannot be over 15 letters long."
Print
title:
Print " New title name to display."
Print " Must be less than 100 letters, numbers, symbols and spaces."
Print " Just press Enter for no title."
Print
Input " ->", nm$
If Len(nm$) > 99 Then
Print
Print " Title name is too long, must be less than 100 letters, numbers, symbols, or spaces."
Print " Try again."
Print
GoTo title
End If
Print
Input " How many words (1-24): ", num
If num > 24 Or num < 1 Or num <> Int(num) Then GoTo begin
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print " Type one word at a time here for your puzzle."
Print
For w = 1 To num
words:
Print Str$(w) + ". ";
Input word$(w)
If Len(word$(w)) > 15 Then Print " Words cannot be over 15 letters long.": Print: GoTo words
temp$ = ""
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) <> " " Then temp$ = temp$ + Mid$(word$(w), ii, 1)
Next ii
If temp$ <> "" Then word$(w) = temp$ ' Only assign if temp$ changed
If word$(w) = "" Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Or word$(w) = " " Then
Print " Nothing typed, try again."
GoTo words
End If
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) < Chr$(65) Or (Mid$(word$(w), ii, 1) > Chr$(90) And Mid$(word$(w), ii, 1) < Chr$(97)) Then
Print " No numbers or symbols, try again.": GoTo words
End If
Next ii
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) > Chr$(122) Then
Print " No numbers or symbols, try again.": GoTo words
End If
Next ii
For ii = 1 To Len(word$(w))
If Mid$(word$(w), ii, 1) > Chr$(96) Or Mid$(word$(w), ii, 1) < Chr$(123) Then
word$(w) = UCase$(word$(w))
End If
Next ii
Next w
Cls
Paint (1, 1), _RGB32(255, 255, 255)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
' Initialize grid
For y = 1 To 18
For x = 1 To 18
grid$(y, x) = ""
Next x
Next y
_PrintString ((_Width / 2) - ((Len(nm$) * 8) / 2), 30), nm$ 'Centers nm$
Randomize Timer
For w = 1 To num
placement:
t = t + 1
If t > 2000 Then
Print word$(w) + " unable to work with this puzzle, press Enter to start over."
Input ab$
t = 0
GoTo begin
End If
dir(w) = Int(Rnd * 8) + 1
x(w) = Int(Rnd * 18) + 1: y(w) = Int(Rnd * 18) + 1
' Ensure the word fits in the selected direction
If dir(w) = 1 And x(w) + Len(word$(w)) > 18 Then GoTo placement ' Right
If dir(w) = 2 And x(w) - Len(word$(w)) < 1 Then GoTo placement ' Left
If dir(w) = 3 And y(w) + Len(word$(w)) > 18 Then GoTo placement ' Down
If dir(w) = 4 And y(w) - Len(word$(w)) < 1 Then GoTo placement ' Up
If dir(w) = 5 And (x(w) + Len(word$(w)) > 18 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Right-Down
If dir(w) = 6 And (x(w) - Len(word$(w)) < 1 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Left-Down
If dir(w) = 7 And (x(w) - Len(word$(w)) < 1 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Left-Up
If dir(w) = 8 And (x(w) + Len(word$(w)) > 18 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Right-Up
' Check for conflicts
For l = 1 To Len(word$(w))
cx = x(w): cy = y(w)
If dir(w) = 1 Then cx = x(w) + l ' Right
If dir(w) = 2 Then cx = x(w) - l ' Left
If dir(w) = 3 Then cy = y(w) + l ' Down
If dir(w) = 4 Then cy = y(w) - l ' Up
If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down
If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down
If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up
If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up
If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement
Next l
' Place word
For l = 1 To Len(word$(w))
cx = x(w): cy = y(w)
If dir(w) = 1 Then cx = x(w) + l ' Right
If dir(w) = 2 Then cx = x(w) - l ' Left
If dir(w) = 3 Then cy = y(w) + l ' Down
If dir(w) = 4 Then cy = y(w) - l ' Up
If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down
If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down
If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up
If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up
grid$(cy, cx) = Mid$(word$(w), l, 1)
Next l
t = 0
Next w
' Fill empty spaces with random letters
For y = 1 To 18
For x = 1 To 18
If grid$(y, x) = "" Then grid$(y, x) = Chr$(Int(Rnd * 26) + 65)
Next x
Next y
' Display grid with spaces between letters
For y = 1 To 18
For x = 1 To 18
Locate y + 5, (x * 2) + 31: Print grid$(y, x); " ";
Next x
Print
Next y
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print word$(l)
Next l
Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
Do
a$ = InKey$
If a$ = "a" Or a$ = "A" Then GoSub answers
If a$ = "s" Or a$ = "S" Then GoSub saving
If a$ = "c" Or a$ = "C" Then
Locate 1, 15: Print " "
_Delay .1
landscape2& = _CopyImage(0)
_ClipboardImage = landscape2&
For sz = 0 To 20
Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 0, 0), B
Next sz
_Delay 2
For sz = 0 To 20
Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B
Next sz
_FreeImage landscape2&
Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
End If
If a$ = "p" Or a$ = "P" Then
Locate 1, 15: Print " "
_Delay .1
'printer prep (code from bplus Free Calendar Program)
YMAX = _Height: XMAX = _Width
landscape& = _NewImage(YMAX, XMAX, 32)
_MapTriangle (XMAX, 0)-(0, 0)-(0, YMAX), 0 To(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
_MapTriangle (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 To(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
_PrintImage landscape&
_Delay 2
_FreeImage landscape&
Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
End If
If a$ = " " Then GoTo begin
If a$ = Chr$(27) Then End
Loop
answers:
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print "(" + Chr$(96 + l) + ") " + word$(l)
Next l
Locate 23, 5: Print "Which word letter?"
Do
pick:
n$ = InKey$
If n$ <> "" Then
If n$ = "a" Or n$ = "A" Then n = 1
If n$ = "b" Or n$ = "B" Then n = 2
If n$ = "c" Or n$ = "C" Then n = 3
If n$ = "d" Or n$ = "D" Then n = 4
If n$ = "e" Or n$ = "E" Then n = 5
If n$ = "f" Or n$ = "F" Then n = 6
If n$ = "g" Or n$ = "G" Then n = 7
If n$ = "h" Or n$ = "H" Then n = 8
If n$ = "i" Or n$ = "I" Then n = 9
If n$ = "j" Or n$ = "J" Then n = 10
If n$ = "k" Or n$ = "K" Then n = 11
If n$ = "l" Or n$ = "L" Then n = 12
If n$ = "m" Or n$ = "M" Then n = 13
If n$ = "n" Or n$ = "N" Then n = 14
If n$ = "o" Or n$ = "O" Then n = 15
If n$ = "p" Or n$ = "P" Then n = 16
If n$ = "q" Or n$ = "Q" Then n = 17
If n$ = "r" Or n$ = "R" Then n = 18
If n$ = "s" Or n$ = "S" Then n = 19
If n$ = "t" Or n$ = "T" Then n = 20
If n$ = "u" Or n$ = "U" Then n = 21
If n$ = "v" Or n$ = "V" Then n = 22
If n$ = "w" Or n$ = "W" Then n = 23
If n$ = "x" Or n$ = "X" Then n = 24
If word$(n) = "" Then GoTo pick
GoTo nex
End If
Loop
nex:
For l = 1 To Len(word$(n))
cx = x(n): cy = y(n)
Select Case dir(n)
Case 1: cx = x(n) + l ' Right
Case 2: cx = x(n) - l ' Left
Case 3: cy = y(n) + l ' Down
Case 4: cy = y(n) - l ' Up
Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down
Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down
Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up
Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up
End Select
Locate cy + 5, (cx * 2) + 30
Color _RGB32(255, 0, 0)
Print grid$(cy, cx);
Next l
_Delay 5
For l = 1 To Len(word$(n))
cx = x(n): cy = y(n)
Select Case dir(n)
Case 1: cx = x(n) + l ' Right
Case 2: cx = x(n) - l ' Left
Case 3: cy = y(n) + l ' Down
Case 4: cy = y(n) - l ' Up
Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down
Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down
Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up
Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up
End Select
Locate cy + 5, (cx * 2) + 30
Color _RGB32(0, 0, 0)
Print grid$(cy, cx);
Next l
Locate 23, 5: Print " "
listx = 15: listy = 25
If num < 7 Then listx = 46
If num > 6 And num < 13 Then listx = 35
If num > 12 And num < 19 Then listx = 28
For l = 1 To num
listy = listy + 1
If listy / 8 = Int(listy / 8) Then
listy = 26: listx = listx + 20
End If
Locate listy, listx: Print " "
Locate listy, listx: Print word$(l)
Next l
n = 0
n$ = ""
Return
saving:
name$ = _InputBox$("Save", "Type a name of file to save without jpg ending.")
If name$ = "" Then GoTo saving
name$ = name$ + ".jpg"
Locate 1, 11: Print " "
_SaveImage name$
path$ = _FullPath$(name$)
_MessageBox "Saved", "Puzzle picture saved as " + name$ + " to " + path$
Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
Return
Posts: 55
Threads: 5
Joined: Apr 2022
Reputation:
5
You can replace
If n$ <> "" Then
If n$ = "a" Or n$ = "A" Then n = 1
If n$ = "b" Or n$ = "B" Then n = 2
If n$ = "c" Or n$ = "C" Then n = 3
If n$ = "d" Or n$ = "D" Then n = 4
If n$ = "e" Or n$ = "E" Then n = 5
If n$ = "f" Or n$ = "F" Then n = 6
If n$ = "g" Or n$ = "G" Then n = 7
If n$ = "h" Or n$ = "H" Then n = 8
If n$ = "i" Or n$ = "I" Then n = 9
If n$ = "j" Or n$ = "J" Then n = 10
If n$ = "k" Or n$ = "K" Then n = 11
If n$ = "l" Or n$ = "L" Then n = 12
If n$ = "m" Or n$ = "M" Then n = 13
If n$ = "n" Or n$ = "N" Then n = 14
If n$ = "o" Or n$ = "O" Then n = 15
If n$ = "p" Or n$ = "P" Then n = 16
If n$ = "q" Or n$ = "Q" Then n = 17
If n$ = "r" Or n$ = "R" Then n = 18
If n$ = "s" Or n$ = "S" Then n = 19
If n$ = "t" Or n$ = "T" Then n = 20
If n$ = "u" Or n$ = "U" Then n = 21
If n$ = "v" Or n$ = "V" Then n = 22
If n$ = "w" Or n$ = "W" Then n = 23
If n$ = "x" Or n$ = "X" Then n = 24
End If
with:
ELM$ = "A1 B2 C3 D4 E5 F6 G7 H8 I9J10K11L12M13N14O15P16Q17R18S19T20U21V22W23X24"
J = InStr(ELM$, UCase$(n$)): n = Val(Mid$(ELM$, J + 1, 2))
Why not yes ?
|
