Code error in creating text files

[Greshter]

Hi All

I'm trying to create a form where you can generate a series of text
files that come from a spreadsheet. The spreadsheet has 7 columns and
each text file should have 7 entries in it (a single record/row). The
spreadsheet looks like:

Name Value 1 Value 2 Value 3 Value 4 Value 5 Value 6

With the code I have I want the text files to have the format:

Value 1
Value 2
Value 3
Value 4
Value 5
Value 6

The file will have the text from the name column as its filename.
However instead of the extension .txt for a text file I would like to
have the extensions .jgw and .jpw and .tfw.

The following code is

Private Sub cmdRange_Click()

Set myRng = Nothing
On Error Resume Next
Set myRng = Application.InputBox(prompt:="Select a range with the
mouse", _
Type:=8)
On Error GoTo 0

If myRng Is Nothing Then
'use hit cancel
Exit Sub
End If

End Sub

Sub cmdGenerate_Click()

'Select worldfile type from option buttons

Select Case True
Case optJpeg.Value
Extension = ".jgw"
MsgBox "You've selected Jpegs"
Case optIllustrator.Value
Extension = ".jpw"
MsgBox "You've selected Illustrator files"
Case optTif.Value
Extension = ".tfw"
MsgBox "You've selected Tif files"
End Select

'Macro for creating world files

ChDir "C:\working_data"

For Each myRng In Range (myRng)
If myRng.Value <> "" Then
FNum = FreeFile
Open myRng.Value & "Extension" For Output Access Write As
#FNum
Print #FNum, myRng(1, 2).Value
Print #FNum, myRng(1, 3).Value
Print #FNum, myRng(1, 4).Value
Print #FNum, myRng(1, 5).Value
Print #FNum, myRng(1, 6).Value
Print #FNum, myRng(1, 7).Value
Close #FNum
End If
Next myRng
End Sub

The code seem okay for the most part but breaks down at

For Each myRng In Range (myRng)

If anybody has ideas out there it would be greatly appreciated.

Thanks,
Mike

 

[Dave Peterson]

I didn't create the userform, but this may get you further along:

Option Explicit
Private Sub CommandButton1_Click()

Dim FileNum As Long
Dim myRng As Range
Dim myCell As Range
Dim myFolder As String
Dim Extension As String
Dim fNum As Long
Dim iCtr As Long

Set myRng = Nothing
On Error Resume Next
Set myRng = Application.InputBox(prompt:="Select a range with the mouse", _
Type:=8)
On Error GoTo 0

If myRng Is Nothing Then
'user hit cancel
Exit Sub
End If

'assumes the name is in column A
Set myRng = myRng.EntireRow.Columns(1)

myFolder = "C:\working_data"
If Right(myFolder, 1) <> "\" Then
myFolder = myFolder & "\"
End If

'for my testing only.
Extension = ".jgw"

' Select Case True
' Case optJpeg.Value
' Extension = ".jgw"
' MsgBox "You've selected Jpegs"
' Case optIllustrator.Value
' Extension = ".jpw"
' MsgBox "You've selected Illustrator files"
' Case optTif.Value
' Extension = ".tfw"
' MsgBox "You've selected Tif files"
' End Select

For Each myCell In myRng.Cells
If myCell.Value <> "" Then
fNum = FreeFile
Close #fNum
Open myFolder & myCell.Value & Extension For Output As #fNum
For iCtr = 1 To 6
Print #fNum, myCell.Offset(0, iCtr).Value
Next iCtr
Close #fNum
End If
Next myCell
End Sub

 

[Greshter]

Dave

You've done it again - just what I'm after. A few tweaks that I can do
but aside from that it's given me a nice little user form.

Thanks very much

p.s - anyplace that you want me to write a little commendation or
something to that effect ... I think you deserve it

 

[Dave Peterson]

Glad you have it working. And thanks for the offer.