I have a user Form with several Check Boxes on it. When I check or uncheck
the Boxes it does not change the boxes in the workbook/worksheet. The User
Form is a different workbook then the Worksheet I want to update.

When you click on the Check box on the worksheet it shows "Check Box ##".
This is the same Workbook/Sheet reference I am using for several other things
and they all update correctly. What did I do wrong?

Here is the code I was trying to use:

Private Sub Update_Installer_Forms_8_Click()

With Workbooks("Master Installer Forms.xlsm").Sheets("Install Pack")
.Range("Check Box 59").Value =
Me("Office_Package_Preparations_101").Value
.Range("Check Box 60").Value =
Me("Office_Package_Preparations_102").Value
.Range("Check Box 61").Value =
Me("Office_Package_Preparations_103").Value
.Range("Check Box 62").Value =
Me("Office_Package_Preparations_104").Value

End With
End Sub

That's a 6+mb file, not practical to try a webQuery.

There are probably different approaches, following is something like this

start downloading the file to memory in chunks
look for the 2nd "short_selling" pos2
then look for "Total", pos3
Start adding chunks after Total to a big string
Stop when "-------" is found pos4

Split the bg string and dump to cells
Might want to do a bit more to put all the values in a table, but that's the
easy part which I'll leave to you.

This is very much bespoke, things could easily change which would require
the code to be modified. As of time of posting seems to work well,
particularly bearing in mind the size of the file

Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000

Private Declare Function InternetOpen Lib "wininet.dll" Alias _
"InternetOpenA" ( _
ByVal lpszAgent As String, _
ByVal dwAccessType As Long, _
ByVal lpszProxy As String, _
ByVal lpszProxyBypass As String, _
ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias _
"InternetOpenUrlA" ( _
ByVal hInternet As Long, _
ByVal lpszUrl As String, _
ByVal lpszHeaders As String, _
ByVal dwHeadersLength As Long, _
ByVal dwFlags As Long, _
ByRef dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
ByRef hInternet As Long) As Boolean ' byref or byval ??
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal dwNumberOfBytesToRead As Long, _
ByRef lpdwNumberOfBytesRead As Long) As Integer
'' note ByVal lpBuffer As String, not ByRef as Any which can crash

Sub Short_selling_To_Cells()
Dim bGrab As Boolean
Dim iRes As Integer
Dim i As Long, nLen As Long
Dim pos1 As Long, pos2 As Long, pos3 As Long, pos4 As Long
Dim hInternetSession As Long, hUrl As Long
Dim nBytes As Long
Dim Buffer As String
Dim bigBuffer As String
Dim sErr As String
Dim arr() As String
Dim cnt As Long
Const cURL As String = "http://www.hkex.com.hk/markdata/quot/d100114e.htm"
Const cANC As String = "short_selling"

On Error GoTo errH

Range("A:F").Clear

'' assumes IE installed
hInternetSession = InternetOpen("IExpore.exe", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, vbNullString, 0)
If hInternetSession = 0 Then Err.Raise 10100

hUrl = InternetOpenUrl(hInternetSession, cURL, vbNullString, _
0, INTERNET_FLAG_EXISTING_CONNECT, 0)
If hUrl = 0 Then Err.Raise 10200

Buffer = Space(4096)
bigBuffer = Space(4096& * 8)

Do

iRes = InternetReadFile(hUrl, Buffer, Len(Buffer), nBytes)

If nBytes = 0 Or iRes = 0 Then Exit Do

If bGrab = False Then

If pos1 = 0 Then
pos1 = InStr(1, Buffer, cANC, vbTextCompare)
If pos1 And pos1 < 4096 Then
pos2 = InStr(pos1 + 1, Buffer, cANC, vbTextCompare)
End If
ElseIf pos2 = 0 Then

pos2 = InStr(1, Buffer, cANC, vbTextCompare)

If pos2 And pos2 < 4096 Then
pos3 = InStr(pos2 + 1, Buffer, "Total", vbTextCompare)
End If

ElseIf pos2 Then
pos3 = InStr(1, Buffer, "Total") + 1

End If

If pos3 Then
bGrab = True
If pos3 < (4096) Then
Buffer = Mid$(Buffer, pos3, Len(Buffer))
End If
End If

End If

If bGrab Then

pos4 = InStr(1, Buffer, "----------")

If pos4 Then
Buffer = Left$(Buffer, pos4 - 1)
End If


If nLen + Len(Buffer) Len(bigBuffer) Then
bigBuffer = bigBuffer & Space(4096& * 8)
End If

Mid$(bigBuffer, nLen + 1, Len(Buffer)) = Buffer

nLen = nLen + Len(Buffer)

If pos4 Then
Exit Do
End If

End If

Loop


If bGrab Then
bigBuffer = Left$(bigBuffer, nLen)
arr = Split(bigBuffer, vbCrLf)

With Range("A1:A" & UBound(arr) + 1)
.Font.Name = "Courier New"
' .Value = arr
End With

For i = 0 To UBound(arr)
Cells(i + 1, 1) = arr(i)
Next
End If

done:

If hUrl Then InternetCloseHandle hUrl
If hInternetSession Then InternetCloseHandle hInternetSession

Exit Sub

errH:
Select Case Erl
Case 10100
sErr = "Error calling InternetOpen"
Case 10200
sErr = "Error calling InternetOpenUrl function"
Case Else
sErr = Err.Description
End Select

MsgBox sErr
' Stop
' Resume
Resume done

End Sub

Regards,
Peter T


"Brian" wrote in message
...
I have a user Form with several Check Boxes on it. When I check or uncheck
the Boxes it does not change the boxes in the workbook/worksheet. The User
Form is a different workbook then the Worksheet I want to update.

When you click on the Check box on the worksheet it shows "Check Box ##".
This is the same Workbook/Sheet reference I am using for several other
things
and they all update correctly. What did I do wrong?

Here is the code I was trying to use:

Private Sub Update_Installer_Forms_8_Click()

With Workbooks("Master Installer Forms.xlsm").Sheets("Install Pack")
.Range("Check Box 59").Value =
Me("Office_Package_Preparations_101").Value
.Range("Check Box 60").Value =
Me("Office_Package_Preparations_102").Value
.Range("Check Box 61").Value =
Me("Office_Package_Preparations_103").Value
.Range("Check Box 62").Value =
Me("Office_Package_Preparations_104").Value

End With
End Sub

I think you have the wrong post. My question was about check boxes.

Have a good one

"Peter T" wrote:

That's a 6+mb file, not practical to try a webQuery.

There are probably different approaches, following is something like this

start downloading the file to memory in chunks
look for the 2nd "short_selling" pos2
then look for "Total", pos3
Start adding chunks after Total to a big string
Stop when "-------" is found pos4

Split the bg string and dump to cells
Might want to do a bit more to put all the values in a table, but that's the
easy part which I'll leave to you.

This is very much bespoke, things could easily change which would require
the code to be modified. As of time of posting seems to work well,
particularly bearing in mind the size of the file

Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000

Private Declare Function InternetOpen Lib "wininet.dll" Alias _
"InternetOpenA" ( _
ByVal lpszAgent As String, _
ByVal dwAccessType As Long, _
ByVal lpszProxy As String, _
ByVal lpszProxyBypass As String, _
ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias _
"InternetOpenUrlA" ( _
ByVal hInternet As Long, _
ByVal lpszUrl As String, _
ByVal lpszHeaders As String, _
ByVal dwHeadersLength As Long, _
ByVal dwFlags As Long, _
ByRef dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
ByRef hInternet As Long) As Boolean ' byref or byval ??
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal dwNumberOfBytesToRead As Long, _
ByRef lpdwNumberOfBytesRead As Long) As Integer
'' note ByVal lpBuffer As String, not ByRef as Any which can crash

Sub Short_selling_To_Cells()
Dim bGrab As Boolean
Dim iRes As Integer
Dim i As Long, nLen As Long
Dim pos1 As Long, pos2 As Long, pos3 As Long, pos4 As Long
Dim hInternetSession As Long, hUrl As Long
Dim nBytes As Long
Dim Buffer As String
Dim bigBuffer As String
Dim sErr As String
Dim arr() As String
Dim cnt As Long
Const cURL As String = "http://www.hkex.com.hk/markdata/quot/d100114e.htm"
Const cANC As String = "short_selling"

On Error GoTo errH

Range("A:F").Clear

'' assumes IE installed
hInternetSession = InternetOpen("IExpore.exe", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, vbNullString, 0)
If hInternetSession = 0 Then Err.Raise 10100

hUrl = InternetOpenUrl(hInternetSession, cURL, vbNullString, _
0, INTERNET_FLAG_EXISTING_CONNECT, 0)
If hUrl = 0 Then Err.Raise 10200

Buffer = Space(4096)
bigBuffer = Space(4096& * 8)

Do

iRes = InternetReadFile(hUrl, Buffer, Len(Buffer), nBytes)

If nBytes = 0 Or iRes = 0 Then Exit Do

If bGrab = False Then

If pos1 = 0 Then
pos1 = InStr(1, Buffer, cANC, vbTextCompare)
If pos1 And pos1 < 4096 Then
pos2 = InStr(pos1 + 1, Buffer, cANC, vbTextCompare)
End If
ElseIf pos2 = 0 Then

pos2 = InStr(1, Buffer, cANC, vbTextCompare)

If pos2 And pos2 < 4096 Then
pos3 = InStr(pos2 + 1, Buffer, "Total", vbTextCompare)
End If

ElseIf pos2 Then
pos3 = InStr(1, Buffer, "Total") + 1

End If

If pos3 Then
bGrab = True
If pos3 < (4096) Then
Buffer = Mid$(Buffer, pos3, Len(Buffer))
End If
End If

End If

If bGrab Then

pos4 = InStr(1, Buffer, "----------")

If pos4 Then
Buffer = Left$(Buffer, pos4 - 1)
End If


If nLen + Len(Buffer) Len(bigBuffer) Then
bigBuffer = bigBuffer & Space(4096& * 8)
End If

Mid$(bigBuffer, nLen + 1, Len(Buffer)) = Buffer

nLen = nLen + Len(Buffer)

If pos4 Then
Exit Do
End If

End If

Loop


If bGrab Then
bigBuffer = Left$(bigBuffer, nLen)
arr = Split(bigBuffer, vbCrLf)

With Range("A1:A" & UBound(arr) + 1)
.Font.Name = "Courier New"
' .Value = arr
End With

For i = 0 To UBound(arr)
Cells(i + 1, 1) = arr(i)
Next
End If

done:

If hUrl Then InternetCloseHandle hUrl
If hInternetSession Then InternetCloseHandle hInternetSession

Exit Sub

errH:
Select Case Erl
Case 10100
sErr = "Error calling InternetOpen"
Case 10200
sErr = "Error calling InternetOpenUrl function"
Case Else
sErr = Err.Description
End Select

MsgBox sErr
' Stop
' Resume
Resume done

End Sub

Regards,
Peter T


"Brian" wrote in message
...
I have a user Form with several Check Boxes on it. When I check or uncheck
the Boxes it does not change the boxes in the workbook/worksheet. The User
Form is a different workbook then the Worksheet I want to update.

When you click on the Check box on the worksheet it shows "Check Box ##".
This is the same Workbook/Sheet reference I am using for several other
things
and they all update correctly. What did I do wrong?

Here is the code I was trying to use:

Private Sub Update_Installer_Forms_8_Click()

With Workbooks("Master Installer Forms.xlsm").Sheets("Install Pack")
.Range("Check Box 59").Value =
Me("Office_Package_Preparations_101").Value
.Range("Check Box 60").Value =
Me("Office_Package_Preparations_102").Value
.Range("Check Box 61").Value =
Me("Office_Package_Preparations_103").Value
.Range("Check Box 62").Value =
Me("Office_Package_Preparations_104").Value

End With
End Sub



.

Oops, not sure how that happened!

Sorry about that,
Peter T

"Brian" wrote in message
...
I think you have the wrong post. My question was about check boxes.

Have a good one

"Peter T" wrote:

That's a 6+mb file, not practical to try a webQuery.

There are probably different approaches, following is something like this

<snip

Having responded to your post with an answer to someone else's thought
better have a look at yours!

If I follow you have checkboxes on a userform, from your Update_Installer
event you want to change corresponding Forms style checkboxes on a worksheet
to equivalent values, right?

Add a Forms style checkbox named "Check Box 1" to Sheet1 and a checkbox
control on a userform named "Checkbox1", with the following code

Change the checkbox on the userform then click anywhere on the form to apply
the change to the worksheet checkbox

Private Sub UserForm_Click()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet1")

ws.CheckBoxes("Check Box 1").Value = _
CLng(Me.Controls("Checkbox1").Value) * -1

' the value checkboxes from the Forms menu is
' xlOn or xlOff, namely 1 or 0
' the *1 is not strictly necessary

End Sub

Regards,
Peter T


"Brian" wrote in message
...
I have a user Form with several Check Boxes on it. When I check or uncheck
the Boxes it does not change the boxes in the workbook/worksheet. The User
Form is a different workbook then the Worksheet I want to update.

When you click on the Check box on the worksheet it shows "Check Box ##".
This is the same Workbook/Sheet reference I am using for several other
things
and they all update correctly. What did I do wrong?

Here is the code I was trying to use:

Private Sub Update_Installer_Forms_8_Click()

With Workbooks("Master Installer Forms.xlsm").Sheets("Install Pack")
.Range("Check Box 59").Value =
Me("Office_Package_Preparations_101").Value
.Range("Check Box 60").Value =
Me("Office_Package_Preparations_102").Value
.Range("Check Box 61").Value =
Me("Office_Package_Preparations_103").Value
.Range("Check Box 62").Value =
Me("Office_Package_Preparations_104").Value

End With
End Sub