sq30
asked on
VBA to copy worksheet range to web based text box padded to mimic worksheet view
Hello,
Attached is a test workbook where I need to copy range A1:J22 from an excel worksheet to a web based applications text box. When doing so the output is not padded and pastes as in the attached file Test1-current.txt. I would like to output to paste as per file Test1-required.txt. The majority of the cells input value lenghts wil be variable.
Please help - thank you.
Sq30
Test1.xlsm
Test1-current.txt
Test1-required.txt
Attached is a test workbook where I need to copy range A1:J22 from an excel worksheet to a web based applications text box. When doing so the output is not padded and pastes as in the attached file Test1-current.txt. I would like to output to paste as per file Test1-required.txt. The majority of the cells input value lenghts wil be variable.
Please help - thank you.
Sq30
Test1.xlsm
Test1-current.txt
Test1-required.txt
there is no code in your workbook.
ASKER
Exactly, as I have no clue how to achieve what I've asked. This is what I'd normally use but the result is not what I require.
Sub DataCopy()
Dim SheetCopy As Worksheet
Set SheetCopy = Worksheets("HelpPlease")
SheetCopy.Range("A1:J22").Copy
End Sub
What browser are you using for your tests and production?
What kind of control are you trying to paste the cell values into?
What kind of control are you trying to paste the cell values into?
ASKER
IE9 and a text box. Is this something your able to help with?
Not a text area control? I need to be able to test any code I create.
Is this your web page or one created by someone else?
I should be able to help. I'm trying to get a handle on the exact nature of the problem you face, which is why I'm asking you questions.
Is this your web page or one created by someone else?
I should be able to help. I'm trying to get a handle on the exact nature of the problem you face, which is why I'm asking you questions.
Also, it might help to know if the Excel data will be in the same format as you've shown or if it is likely to change.
This is going to get us close.
The deficit with this code is that it does not properly account for text that runs past its cell. That is why row 7 contents wrap around to line 8 in the output.
The deficit with this code is that it does not properly account for text that runs past its cell. That is why row 7 contents wrap around to line 8 in the output.
Sub Q_28474773()
Dim vMatrix As Variant
Dim strOutput() As String
Dim lngRow As Long, lngCol As Long, lngMergedCol As Long
Dim oDO As Object
Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
vMatrix = ActiveSheet.Range("a1", "j22").Value
' Debug.Print LBound(vMatrix, 1), UBound(vMatrix, 1)
' Debug.Print LBound(vMatrix, 2), UBound(vMatrix, 2)
ReDim strOutput(1 To UBound(vMatrix, 1))
For lngRow = 1 To UBound(vMatrix, 1)
For lngCol = 1 To UBound(vMatrix, 2)
If ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count = 1 Then
If Len(vMatrix(lngRow, lngCol)) <= 14 Then
strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
Else
strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
End If
Else
If Len(vMatrix(lngRow, lngCol)) <= 14 Then
For lngMergedCol = 1 To ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count
strOutput(lngRow) = strOutput(lngRow) & Space(14)
Next
Else
strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
End If
End If
Next
strOutput(lngRow) = RTrim(strOutput(lngRow))
'Debug.Print strOutput(lngRow)
Next
oDO.Clear
oDO.SetText Join(strOutput, vbCrLf)
oDO.PutInClipboard
End Sub
ASKER
Its not a page I've created so I can't tell you further than that. The format of the text will be the same but the length in the cells variable. If i was going to do this on the worksheet I'd get the length of each cell and the maximum value in the column and then perhaps vlookup for cells with that have values of 1,2 ,3 spaces etc and concatenate that. I was hoping that there is an easier method. Thinking about this futher I need to let you know how long each line is in the text box to preven wrapping. I can't do this at the moment.
ASKER
Sorry posts crossed. I'll test asap - thank you.
This is very close.
I'm testing the results in a textarea. Here is my sample/test HTML
Sub Q_28474773()
Dim vMatrix As Variant
Dim strOutput() As String
Dim lngRow As Long, lngCol As Long, lngMergedCol As Long, lngSkip As Long
Dim oDO As Object
Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
vMatrix = ActiveSheet.Range("a1", "j22").Value
' Debug.Print LBound(vMatrix, 1), UBound(vMatrix, 1)
' Debug.Print LBound(vMatrix, 2), UBound(vMatrix, 2)
ReDim strOutput(1 To UBound(vMatrix, 1))
For lngRow = 1 To UBound(vMatrix, 1)
For lngCol = 1 To UBound(vMatrix, 2)
If lngSkip > 0 Then
lngSkip = lngSkip - 1
Else
If ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count = 1 Then
If Len(vMatrix(lngRow, lngCol)) <= 14 Then
strOutput(lngRow) = strOutput(lngRow) & Left(RTrim(vMatrix(lngRow, lngCol)) & Space(14), 14)
Else
strOutput(lngRow) = strOutput(lngRow) & RTrim(vMatrix(lngRow, lngCol)) & Space(Len(RTrim(vMatrix(lngRow, lngCol))) Mod 14)
lngSkip = (Len(RTrim(vMatrix(lngRow, lngCol))) \ 14) + 2
End If
Else
If Len(vMatrix(lngRow, lngCol)) <= 14 Then
For lngMergedCol = 1 To ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count
strOutput(lngRow) = strOutput(lngRow) & Space(14)
Next
Else
strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
End If
End If
End If
Next
strOutput(lngRow) = RTrim(strOutput(lngRow))
'Debug.Print strOutput(lngRow)
Next
oDO.Clear
oDO.SetText Join(strOutput, vbCrLf)
oDO.PutInClipboard
End Sub
I'm testing the results in a textarea. Here is my sample/test HTML
<!DOCTYPE html>
<html>
<head>
<style>
textarea { font-size: 18px; font-family: courier;}
</style>
</head>
<body>
<pre>
<textarea name="BasicTextArea" rows="25" cols="120"></textarea>
</pre>
</body>
</html>
ASKER
You're getting very close - thank you.
The text box is 110 characters wide. The cells formated as numbers are not displaying correctly and showing as e.g 2250.438 for 2250.44 and 151 for 151.00
The second code is truncating some of the values.
Test1-2.xlsm
The text box is 110 characters wide. The cells formated as numbers are not displaying correctly and showing as e.g 2250.438 for 2250.44 and 151 for 151.00
The second code is truncating some of the values.
Test1-2.xlsm
most everything is lining up. I'm trying to figure out what is happening on rows [4,20..22]. On these rows, there appears to be some single character shift of text, either left or right.
Sub Q_28474773()
Dim vMatrix As Variant
Dim strOutput() As String
Dim lngRow As Long, lngCol As Long, lngMergedCol As Long, lngSkip As Long
Dim rng As Range
Dim oDO As Object
Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set rng = ActiveSheet.Range("a1", "j22")
ReDim vMatrix(1 To rng.Rows.Count, 1 To rng.Columns.Count)
For lngRow = 1 To rng.Rows.Count
For lngCol = 1 To rng.Columns.Count
vMatrix(lngRow, lngCol) = Trim(ActiveSheet.Cells(lngRow, lngCol).Text)
Next
Next
ReDim strOutput(1 To UBound(vMatrix, 1))
For lngRow = 1 To UBound(vMatrix, 1)
For lngCol = 1 To UBound(vMatrix, 2)
If lngSkip > 0 Then
lngSkip = lngSkip - 1
Else
If ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count = 1 Then
If Len(vMatrix(lngRow, lngCol)) <= 14 Then
' strOutput(lngRow) = strOutput(lngRow) & Left(Trim(ActiveSheet.Cells(lngRow, lngCol).Text) & Space(14), 14)
Select Case ActiveSheet.Cells(lngRow, lngCol).HorizontalAlignment
Case xlHAlignGeneral
Select Case ActiveSheet.Cells(lngRow, lngCol).NumberFormat
Case "General"
If IsNumeric(ActiveSheet.Cells(lngRow, lngCol).Value) Then
strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
Else
strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
End If
Case "@"
strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
Case Else
strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
End Select
Case xlHAlignLeft
strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
Case xlHAlignRight
strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
Case xlHAlignCenter
If Len(vMatrix(lngRow, lngCol)) Mod 2 = 0 Then
strOutput(lngRow) = strOutput(lngRow) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2) & vMatrix(lngRow, lngCol) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2)
Else
strOutput(lngRow) = strOutput(lngRow) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2) & vMatrix(lngRow, lngCol) & Space(((14 - Len(vMatrix(lngRow, lngCol))) / 2) - 1)
End If
End Select
Else
strOutput(lngRow) = strOutput(lngRow) & RTrim(vMatrix(lngRow, lngCol)) & Space(Len(RTrim(vMatrix(lngRow, lngCol))) Mod 14)
lngSkip = (Len(RTrim(vMatrix(lngRow, lngCol))) \ 14) + 2
End If
Else
If Len(vMatrix(lngRow, lngCol)) <= 14 Then
For lngMergedCol = 1 To ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count
strOutput(lngRow) = strOutput(lngRow) & Space(14)
Next
Else
strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
End If
End If
End If
Next
strOutput(lngRow) = RTrim(strOutput(lngRow))
'Debug.Print strOutput(lngRow)
Next
oDO.Clear
oDO.SetText Join(strOutput, vbCrLf)
oDO.PutInClipboard
End Sub
I wasn't handling the centered text properly. Arithmetic fixed. Looks pretty.
Sub Q_28474773()
Dim vMatrix As Variant
Dim strOutput() As String
Dim lngRow As Long, lngCol As Long, lngMergedCol As Long, lngSkip As Long
Dim rng As Range
Dim oDO As Object
Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set rng = ActiveSheet.Range("a1", "j22")
ReDim vMatrix(1 To rng.Rows.Count, 1 To rng.Columns.Count)
For lngRow = 1 To rng.Rows.Count
For lngCol = 1 To rng.Columns.Count
vMatrix(lngRow, lngCol) = Trim(ActiveSheet.Cells(lngRow, lngCol).Text)
Next
Next
ReDim strOutput(1 To UBound(vMatrix, 1))
For lngRow = 1 To UBound(vMatrix, 1)
For lngCol = 1 To UBound(vMatrix, 2)
If lngSkip > 0 Then
lngSkip = lngSkip - 1
Else
If ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count = 1 Then
If Len(vMatrix(lngRow, lngCol)) <= 14 Then
' strOutput(lngRow) = strOutput(lngRow) & Left(Trim(ActiveSheet.Cells(lngRow, lngCol).Text) & Space(14), 14)
Select Case ActiveSheet.Cells(lngRow, lngCol).HorizontalAlignment
Case xlHAlignGeneral
Select Case ActiveSheet.Cells(lngRow, lngCol).NumberFormat
Case "General"
If IsNumeric(ActiveSheet.Cells(lngRow, lngCol).Value) Then
strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
Else
strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
End If
Case "@"
strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
Case Else
strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
End Select
Case xlHAlignLeft
strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
Case xlHAlignRight
strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
Case xlHAlignCenter
If Len(vMatrix(lngRow, lngCol)) Mod 2 = 0 Then
strOutput(lngRow) = strOutput(lngRow) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2) & vMatrix(lngRow, lngCol) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2)
Else
strOutput(lngRow) = strOutput(lngRow) & Space((14 - Len(vMatrix(lngRow, lngCol)) + 1) / 2) & vMatrix(lngRow, lngCol) & Space(((14 - Len(vMatrix(lngRow, lngCol)) - 1) \ 2))
End If
End Select
Else
strOutput(lngRow) = strOutput(lngRow) & RTrim(vMatrix(lngRow, lngCol)) & Space(Len(RTrim(vMatrix(lngRow, lngCol))) Mod 14)
lngSkip = (Len(RTrim(vMatrix(lngRow, lngCol))) \ 14) + 2
End If
Else
If Len(vMatrix(lngRow, lngCol)) <= 14 Then
For lngMergedCol = 1 To ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count
strOutput(lngRow) = strOutput(lngRow) & Space(14)
Next
Else
strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
End If
End If
End If
Next
strOutput(lngRow) = RTrim(strOutput(lngRow))
'Debug.Print strOutput(lngRow)
Next
oDO.Clear
oDO.SetText Join(strOutput, vbCrLf)
oDO.PutInClipboard
End Sub
ASKER
Looking better but row 8 is missing data.
Test1-3.xlsm
Test1-3.xlsm
I see that. Puzzling.
I'm going to do a major overhaul of the code
ASKER
Thank you.
ASKER
Hows the code coming along?
I'm testing my changes. Stepping through the code.
ASKER
Hello aikimark - I'm dissapointed with EE that I don't have a workable solution by now as my question from my perspective is nearly five days old. I do understand that this is an unpaid side line for you experts however I need a workable answer. It's 2300 here in the UK and if your unable to give me a solution by the morning please let me know so that I can request attention. Many thanks for what you've done thus far.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Using your last code the text it's still miss-aligned in places which is to do with the type of input box being used my end as when I use this code with the html you supplied it works perfect. Thank you.
when I use this code with the html you supplied it worksWhat is the difference between my test page and the page you are using?
ASKER
Nothing noticable and the clipboard pastes fine. It's once I press save one the web page that something happens to the input which ends up as per the screen shot.
Change line 111 to this and retest.
oDO.SetText Replace(Join(strOutput, vbCrLf), " ", " ")
ASKER
Every space character is replaced with the text " "
I understand. What happens when you press the Save button?
ASKER
If you look at the screen dupms tab of the last file I attached you will see it's knocking the formating/spacing out.
It appears that you are pasting into a proportionally spaced font text area. Unless you can paste an HTML table or change the destination text are to a mono-spaced font, I don't think there is anything I can do. I created an HTML file for my testing way back on 7/14 (http:#a40195047 ). I do not know what your destination page looks like.
What are you trying to accomplish with the data? Do not reply with a copy/paste answer. I'm looking for the actual problem (What) you are trying to solve, not a How-to problem definition
What are you trying to accomplish with the data? Do not reply with a copy/paste answer. I'm looking for the actual problem (What) you are trying to solve, not a How-to problem definition
ASKER
Then there is no answer.
If you copied a table from a web page and paste it into the page, what does it look like?
ASKER
It stacks each cell on its own line
are you pasting into a textarea or an input type="text"?
ASKER
sorry for the delay was trying to have a pc free day today. I'm believe I'm pasting into a text area and viewing the source code reveals that the page is made up of frames. I cannot see any metion of the font being used and I think you've probably hit the nail on the head with proportionally spaced font text area.
In most modern browsers you can inspect any given element and easily see the HTML and CSS related to that element. Some will allow you to change the element on the fly.
I think I must be missing something about the transfer of data into the web/server-based application.
I think I must be missing something about the transfer of data into the web/server-based application.