Hello,
I was testing VB code to modify the interface of VBA-programmed Excel
workbooks. Afterwards the two workbooks were shown in their folder and the
interface of one of the worksheets was displayed to the side, but when I
attempt to open either of the two books, Excel app opens but not the specific
workbooks themselves. It just shows the Excel workbook bar at top but empty
of contents. I can open the properties for either of the workbooks and it
shows the Hidden feature is unchecked.
Any idea of what happened, and/or how I can get the workbooks to display and
open?
Thanks, God bless

VanS,

To help you in this you need to post the code you are using.

"VanS" wrote:

Hello,
I was testing VB code to modify the interface of VBA-programmed Excel
workbooks. Afterwards the two workbooks were shown in their folder and the
interface of one of the worksheets was displayed to the side, but when I
attempt to open either of the two books, Excel app opens but not the specific
workbooks themselves. It just shows the Excel workbook bar at top but empty
of contents. I can open the properties for either of the workbooks and it
shows the Hidden feature is unchecked.
Any idea of what happened, and/or how I can get the workbooks to display and
open?
Thanks, God bless

Sure, see below. My original query didn't have code or get a response so I
resubmitted with below.. Thanks for your help, God bless
Option Explicit

Dim exc As EXCEl.Application

Private Sub cmdChange_Click()

strFolder = txtPath.Text
Len(txtPath.Text) - 3)
' get th search path
strPath = strFolder & "\" & "*.xls"
' get the first file with workbook extension
strFile = Dir(strPath, vbNormal)
Do While Len(strFile) < 0
'booReadOnly = False

If UCase(Left(strFile, 13)) = "EQUIPMENT VOL" Then

If GetAttr(strFolder & "\" & strFile) = vbReadOnly Then
' booReadOnly = True
SetAttr (strFolder & "\" & strFile), vbNormal
End If
'09/20/07 code below original code that worked-commented out to check
for err & added code below it

Set excBk = GetObject(strFolder & "\" & strFile, "Excel.Sheet")

For ndx = 1 To excBk.Worksheets.Count
excBk.Worksheets(ndx).Unprotect

FixLabels ndx '10/27/01
excBk.Worksheets(ndx).Protect

Next ndx 'ndx = 1 To excBk.Application.ActiveWorkbook.Worksheets.Count

excBk.Close savechanges:=True
Set excBk = Nothing '09/27/07
' check for next file
End If

strFile = Dir
Loop



End Sub


Module 1
Option Explicit
Public excBk as EXCEl.Workbook

Public Sub FixLabels(ndx As Integer)


Dim booNegative As Boolean
Dim dblCost As Double
Dim strVal As String
Dim row As Integer
Dim cell As Range


booNegative = False



excBk.Worksheets(ndx).Select
excBk.Worksheets(ndx).Activate

With excBk.Worksheets(ndx).Range("D10")
..HorizontalAlignment = xlHAlignCenter
..Value = "Standard Equipment"
..Font.Size = 10
'.Font.Bold = True
End With

With excBk.Worksheets(ndx).Range("rngReqd")
..HorizontalAlignment = xlHAlignCenter
..Value = "Must Select One from Each Box"
..Font.Size = 10
..Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngDesired")
..HorizontalAlignment = xlHAlignCenter
..Value = "Attachments-Factory Installed"
..Font.Size = 10
..Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngField")
..HorizontalAlignment = xlHAlignCenter
..Value = "Attachments-Installed On-Site"
..Font.Size = 10
..Font.Bold = True
End With
' ChangeFormula ndx
row = excBk.Worksheets(ndx).Range("rngTerminusRw").Rows. row

For Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)
booNegative = False
If Not IsEmpty(cell.Value) Then
strVal = cell.Value
If UCase(Right(strVal, 1)) = "X" Then
booNegative = True
strVal = Left(strVal, Len(strVal) - 1)
End If
dblCost = CalcCost(strVal)
strVal = dblCost
strVal = ConvCost(strVal, booNegative)
cell.Value = strVal
End If 'Not IsEmpty(cell.Value) Then
Next 'Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)






End Sub


Public Function CalcCost(strVal As String)
Dim bytLen As Byte
Dim strCents As String
Dim str1000 As String
Dim strDollars As String

strCents = Mid(strVal, 1, 2)
str1000 = Mid(strVal, 3, 1)
strDollars = Mid(strVal, 5)
CalcCost = Val(str1000 & strDollars & "." & strCents)

End Function

Public Function ConvCost(strVal As String, booNegative As Boolean)
Dim bytPeriodPos As Byte
Dim bytLen As Byte
Dim dblCost As Double
Dim strCents As String
Dim str1000 As String
Dim strDollars As String


dblCost = strVal
str1000 = Mid(dblCost, 1, 1)
' get position of decimal point
bytPeriodPos = InStr(Format(dblCost, "Fixed"), ".")
' 43,350.00 - 400N3350
'4350.50-450N350
'435.75-475N35
'43.50-450N3
'4.30- 430N

' get length of vals to go after alpha char
' if only one digit bytLen will = 0 and strDollars = ""
' so won't add to concatenation
If bytPeriodPos - 2 0 Then
bytLen = bytPeriodPos - 2
End If
strDollars = Mid(dblCost, 2, bytLen)
strCents = Right(Format(dblCost, "Fixed"), 2)
If booNegative Then
ConvCost = (str1000 & strCents & "N" & strDollars & "X")
Else
ConvCost = (str1000 & strCents & "N" & strDollars)
End If
End Function


"JRForm" wrote:

VanS,

To help you in this you need to post the code you are using.

"VanS" wrote:

Hello,
I was testing VB code to modify the interface of VBA-programmed Excel
workbooks. Afterwards the two workbooks were shown in their folder and the
interface of one of the worksheets was displayed to the side, but when I
attempt to open either of the two books, Excel app opens but not the specific
workbooks themselves. It just shows the Excel workbook bar at top but empty
of contents. I can open the properties for either of the workbooks and it
shows the Hidden feature is unchecked.
Any idea of what happened, and/or how I can get the workbooks to display and
open?
Thanks, God bless

VanS,

I would like to help but I need a little more information and understanding.
So your application is creating an instance of Excel and then
*opening files from a specific directiory
*manipulating some named ranges
*doing some calculations
*protecting the worksheet
After all this the files are empty of data and not readable by excel?



"VanS" wrote:

Sure, see below. My original query didn't have code or get a response so I
resubmitted with below.. Thanks for your help, God bless
Option Explicit

Dim exc As EXCEl.Application

Private Sub cmdChange_Click()

strFolder = txtPath.Text
Len(txtPath.Text) - 3)
' get th search path
strPath = strFolder & "\" & "*.xls"
' get the first file with workbook extension
strFile = Dir(strPath, vbNormal)
Do While Len(strFile) < 0
'booReadOnly = False

If UCase(Left(strFile, 13)) = "EQUIPMENT VOL" Then

If GetAttr(strFolder & "\" & strFile) = vbReadOnly Then
' booReadOnly = True
SetAttr (strFolder & "\" & strFile), vbNormal
End If
'09/20/07 code below original code that worked-commented out to check
for err & added code below it

Set excBk = GetObject(strFolder & "\" & strFile, "Excel.Sheet")

For ndx = 1 To excBk.Worksheets.Count
excBk.Worksheets(ndx).Unprotect

FixLabels ndx '10/27/01
excBk.Worksheets(ndx).Protect

Next ndx 'ndx = 1 To excBk.Application.ActiveWorkbook.Worksheets.Count

excBk.Close savechanges:=True
Set excBk = Nothing '09/27/07
' check for next file
End If

strFile = Dir
Loop



End Sub


Module 1
Option Explicit
Public excBk as EXCEl.Workbook

Public Sub FixLabels(ndx As Integer)


Dim booNegative As Boolean
Dim dblCost As Double
Dim strVal As String
Dim row As Integer
Dim cell As Range


booNegative = False



excBk.Worksheets(ndx).Select
excBk.Worksheets(ndx).Activate

With excBk.Worksheets(ndx).Range("D10")
.HorizontalAlignment = xlHAlignCenter
.Value = "Standard Equipment"
.Font.Size = 10
'.Font.Bold = True
End With

With excBk.Worksheets(ndx).Range("rngReqd")
.HorizontalAlignment = xlHAlignCenter
.Value = "Must Select One from Each Box"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngDesired")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Factory Installed"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngField")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Installed On-Site"
.Font.Size = 10
.Font.Bold = True
End With
' ChangeFormula ndx
row = excBk.Worksheets(ndx).Range("rngTerminusRw").Rows. row

For Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)
booNegative = False
If Not IsEmpty(cell.Value) Then
strVal = cell.Value
If UCase(Right(strVal, 1)) = "X" Then
booNegative = True
strVal = Left(strVal, Len(strVal) - 1)
End If
dblCost = CalcCost(strVal)
strVal = dblCost
strVal = ConvCost(strVal, booNegative)
cell.Value = strVal
End If 'Not IsEmpty(cell.Value) Then
Next 'Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)






End Sub


Public Function CalcCost(strVal As String)
Dim bytLen As Byte
Dim strCents As String
Dim str1000 As String
Dim strDollars As String

strCents = Mid(strVal, 1, 2)
str1000 = Mid(strVal, 3, 1)
strDollars = Mid(strVal, 5)
CalcCost = Val(str1000 & strDollars & "." & strCents)

End Function

Public Function ConvCost(strVal As String, booNegative As Boolean)
Dim bytPeriodPos As Byte
Dim bytLen As Byte
Dim dblCost As Double
Dim strCents As String
Dim str1000 As String
Dim strDollars As String


dblCost = strVal
str1000 = Mid(dblCost, 1, 1)
' get position of decimal point
bytPeriodPos = InStr(Format(dblCost, "Fixed"), ".")
' 43,350.00 - 400N3350
'4350.50-450N350
'435.75-475N35
'43.50-450N3
'4.30- 430N

' get length of vals to go after alpha char
' if only one digit bytLen will = 0 and strDollars = ""
' so won't add to concatenation
If bytPeriodPos - 2 0 Then
bytLen = bytPeriodPos - 2
End If
strDollars = Mid(dblCost, 2, bytLen)
strCents = Right(Format(dblCost, "Fixed"), 2)
If booNegative Then
ConvCost = (str1000 & strCents & "N" & strDollars & "X")
Else
ConvCost = (str1000 & strCents & "N" & strDollars)
End If
End Function


"JRForm" wrote:

VanS,

To help you in this you need to post the code you are using.

"VanS" wrote:

Hello,
I was testing VB code to modify the interface of VBA-programmed Excel
workbooks. Afterwards the two workbooks were shown in their folder and the
interface of one of the worksheets was displayed to the side, but when I
attempt to open either of the two books, Excel app opens but not the specific
workbooks themselves. It just shows the Excel workbook bar at top but empty
of contents. I can open the properties for either of the workbooks and it
shows the Hidden feature is unchecked.
Any idea of what happened, and/or how I can get the workbooks to display and
open?
Thanks, God bless

Thanks for your reply. Yes, I have my Excel VBA app in numerous workbooks. I
need to modify the interface of the many worksheets but I am using VB6 and I
suppose automation to open each workbook and do the modifications which
specifically are to change the contents of certain ranges I am using as
labels (4 of them on each worksheet), and change the format of an encoded
numeric value to another format. To do the latter I use the CalcCost function
to derive the numeric value of the encoded number (with an alpha character in
it) and the ConvCost to re-create the value with a new format.
Yes, I unprotect each worksheet before the work is done, then re-protect it.
The code seems to perform ok, but for some reason at some point in the
execution of the code, the workbook, although it's icon appears in its
folder, when I click on it to open it, it doesn't display anything-only an
Excel application title bar without any contents or name of the workbook. I'm
trying to take the code through debug and see where the problem begins but I
haven't been able to work continuously on it.
Any idea of what the problem may be?
Thanks, God bless
Van

"JRForm" wrote:

VanS,

I would like to help but I need a little more information and understanding.
So your application is creating an instance of Excel and then
*opening files from a specific directiory
*manipulating some named ranges
*doing some calculations
*protecting the worksheet
After all this the files are empty of data and not readable by excel?



"VanS" wrote:

Sure, see below. My original query didn't have code or get a response so I
resubmitted with below.. Thanks for your help, God bless
Option Explicit

Dim exc As EXCEl.Application

Private Sub cmdChange_Click()

strFolder = txtPath.Text
Len(txtPath.Text) - 3)
' get th search path
strPath = strFolder & "\" & "*.xls"
' get the first file with workbook extension
strFile = Dir(strPath, vbNormal)
Do While Len(strFile) < 0
'booReadOnly = False

If UCase(Left(strFile, 13)) = "EQUIPMENT VOL" Then

If GetAttr(strFolder & "\" & strFile) = vbReadOnly Then
' booReadOnly = True
SetAttr (strFolder & "\" & strFile), vbNormal
End If
'09/20/07 code below original code that worked-commented out to check
for err & added code below it

Set excBk = GetObject(strFolder & "\" & strFile, "Excel.Sheet")

For ndx = 1 To excBk.Worksheets.Count
excBk.Worksheets(ndx).Unprotect

FixLabels ndx '10/27/01
excBk.Worksheets(ndx).Protect

Next ndx 'ndx = 1 To excBk.Application.ActiveWorkbook.Worksheets.Count

excBk.Close savechanges:=True
Set excBk = Nothing '09/27/07
' check for next file
End If

strFile = Dir
Loop



End Sub


Module 1
Option Explicit
Public excBk as EXCEl.Workbook

Public Sub FixLabels(ndx As Integer)


Dim booNegative As Boolean
Dim dblCost As Double
Dim strVal As String
Dim row As Integer
Dim cell As Range


booNegative = False



excBk.Worksheets(ndx).Select
excBk.Worksheets(ndx).Activate

With excBk.Worksheets(ndx).Range("D10")
.HorizontalAlignment = xlHAlignCenter
.Value = "Standard Equipment"
.Font.Size = 10
'.Font.Bold = True
End With

With excBk.Worksheets(ndx).Range("rngReqd")
.HorizontalAlignment = xlHAlignCenter
.Value = "Must Select One from Each Box"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngDesired")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Factory Installed"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngField")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Installed On-Site"
.Font.Size = 10
.Font.Bold = True
End With
' ChangeFormula ndx
row = excBk.Worksheets(ndx).Range("rngTerminusRw").Rows. row

For Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)
booNegative = False
If Not IsEmpty(cell.Value) Then
strVal = cell.Value
If UCase(Right(strVal, 1)) = "X" Then
booNegative = True
strVal = Left(strVal, Len(strVal) - 1)
End If
dblCost = CalcCost(strVal)
strVal = dblCost
strVal = ConvCost(strVal, booNegative)
cell.Value = strVal
End If 'Not IsEmpty(cell.Value) Then
Next 'Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)






End Sub


Public Function CalcCost(strVal As String)
Dim bytLen As Byte
Dim strCents As String
Dim str1000 As String
Dim strDollars As String

strCents = Mid(strVal, 1, 2)
str1000 = Mid(strVal, 3, 1)
strDollars = Mid(strVal, 5)
CalcCost = Val(str1000 & strDollars & "." & strCents)

End Function

Public Function ConvCost(strVal As String, booNegative As Boolean)
Dim bytPeriodPos As Byte
Dim bytLen As Byte
Dim dblCost As Double
Dim strCents As String
Dim str1000 As String
Dim strDollars As String


dblCost = strVal
str1000 = Mid(dblCost, 1, 1)
' get position of decimal point
bytPeriodPos = InStr(Format(dblCost, "Fixed"), ".")
' 43,350.00 - 400N3350
'4350.50-450N350
'435.75-475N35
'43.50-450N3
'4.30- 430N

' get length of vals to go after alpha char
' if only one digit bytLen will = 0 and strDollars = ""
' so won't add to concatenation
If bytPeriodPos - 2 0 Then
bytLen = bytPeriodPos - 2
End If
strDollars = Mid(dblCost, 2, bytLen)
strCents = Right(Format(dblCost, "Fixed"), 2)
If booNegative Then
ConvCost = (str1000 & strCents & "N" & strDollars & "X")
Else
ConvCost = (str1000 & strCents & "N" & strDollars)
End If
End Function


"JRForm" wrote:

VanS,

To help you in this you need to post the code you are using.

"VanS" wrote:

Hello,
I was testing VB code to modify the interface of VBA-programmed Excel
workbooks. Afterwards the two workbooks were shown in their folder and the
interface of one of the worksheets was displayed to the side, but when I
attempt to open either of the two books, Excel app opens but not the specific
workbooks themselves. It just shows the Excel workbook bar at top but empty
of contents. I can open the properties for either of the workbooks and it
shows the Hidden feature is unchecked.
Any idea of what happened, and/or how I can get the workbooks to display and
open?
Thanks, God bless

VanS,

I tried to run some of your code and it is running in the background so I
was not able to debug the problem. Try breaking your code into the specific
steps (sub routines) and then test them before putting them all together. I
would also try to start the Excel app and not close the files or protect them
as this will most likely be the last operation.

"VanS" wrote:

Thanks for your reply. Yes, I have my Excel VBA app in numerous workbooks. I
need to modify the interface of the many worksheets but I am using VB6 and I
suppose automation to open each workbook and do the modifications which
specifically are to change the contents of certain ranges I am using as
labels (4 of them on each worksheet), and change the format of an encoded
numeric value to another format. To do the latter I use the CalcCost function
to derive the numeric value of the encoded number (with an alpha character in
it) and the ConvCost to re-create the value with a new format.
Yes, I unprotect each worksheet before the work is done, then re-protect it.
The code seems to perform ok, but for some reason at some point in the
execution of the code, the workbook, although it's icon appears in its
folder, when I click on it to open it, it doesn't display anything-only an
Excel application title bar without any contents or name of the workbook. I'm
trying to take the code through debug and see where the problem begins but I
haven't been able to work continuously on it.
Any idea of what the problem may be?
Thanks, God bless
Van

"JRForm" wrote:

VanS,

I would like to help but I need a little more information and understanding.
So your application is creating an instance of Excel and then
*opening files from a specific directiory
*manipulating some named ranges
*doing some calculations
*protecting the worksheet
After all this the files are empty of data and not readable by excel?



"VanS" wrote:

Sure, see below. My original query didn't have code or get a response so I
resubmitted with below.. Thanks for your help, God bless
Option Explicit

Dim exc As EXCEl.Application

Private Sub cmdChange_Click()

strFolder = txtPath.Text
Len(txtPath.Text) - 3)
' get th search path
strPath = strFolder & "\" & "*.xls"
' get the first file with workbook extension
strFile = Dir(strPath, vbNormal)
Do While Len(strFile) < 0
'booReadOnly = False

If UCase(Left(strFile, 13)) = "EQUIPMENT VOL" Then

If GetAttr(strFolder & "\" & strFile) = vbReadOnly Then
' booReadOnly = True
SetAttr (strFolder & "\" & strFile), vbNormal
End If
'09/20/07 code below original code that worked-commented out to check
for err & added code below it

Set excBk = GetObject(strFolder & "\" & strFile, "Excel.Sheet")

For ndx = 1 To excBk.Worksheets.Count
excBk.Worksheets(ndx).Unprotect

FixLabels ndx '10/27/01
excBk.Worksheets(ndx).Protect

Next ndx 'ndx = 1 To excBk.Application.ActiveWorkbook.Worksheets.Count

excBk.Close savechanges:=True
Set excBk = Nothing '09/27/07
' check for next file
End If

strFile = Dir
Loop



End Sub


Module 1
Option Explicit
Public excBk as EXCEl.Workbook

Public Sub FixLabels(ndx As Integer)


Dim booNegative As Boolean
Dim dblCost As Double
Dim strVal As String
Dim row As Integer
Dim cell As Range


booNegative = False



excBk.Worksheets(ndx).Select
excBk.Worksheets(ndx).Activate

With excBk.Worksheets(ndx).Range("D10")
.HorizontalAlignment = xlHAlignCenter
.Value = "Standard Equipment"
.Font.Size = 10
'.Font.Bold = True
End With

With excBk.Worksheets(ndx).Range("rngReqd")
.HorizontalAlignment = xlHAlignCenter
.Value = "Must Select One from Each Box"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngDesired")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Factory Installed"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngField")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Installed On-Site"
.Font.Size = 10
.Font.Bold = True
End With
' ChangeFormula ndx
row = excBk.Worksheets(ndx).Range("rngTerminusRw").Rows. row

For Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)
booNegative = False
If Not IsEmpty(cell.Value) Then
strVal = cell.Value
If UCase(Right(strVal, 1)) = "X" Then
booNegative = True
strVal = Left(strVal, Len(strVal) - 1)
End If
dblCost = CalcCost(strVal)
strVal = dblCost
strVal = ConvCost(strVal, booNegative)
cell.Value = strVal
End If 'Not IsEmpty(cell.Value) Then
Next 'Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)






End Sub


Public Function CalcCost(strVal As String)
Dim bytLen As Byte
Dim strCents As String
Dim str1000 As String
Dim strDollars As String

strCents = Mid(strVal, 1, 2)
str1000 = Mid(strVal, 3, 1)
strDollars = Mid(strVal, 5)
CalcCost = Val(str1000 & strDollars & "." & strCents)

End Function

Public Function ConvCost(strVal As String, booNegative As Boolean)
Dim bytPeriodPos As Byte
Dim bytLen As Byte
Dim dblCost As Double
Dim strCents As String
Dim str1000 As String
Dim strDollars As String


dblCost = strVal
str1000 = Mid(dblCost, 1, 1)
' get position of decimal point
bytPeriodPos = InStr(Format(dblCost, "Fixed"), ".")
' 43,350.00 - 400N3350
'4350.50-450N350
'435.75-475N35
'43.50-450N3
'4.30- 430N

' get length of vals to go after alpha char
' if only one digit bytLen will = 0 and strDollars = ""
' so won't add to concatenation
If bytPeriodPos - 2 0 Then
bytLen = bytPeriodPos - 2
End If
strDollars = Mid(dblCost, 2, bytLen)
strCents = Right(Format(dblCost, "Fixed"), 2)
If booNegative Then
ConvCost = (str1000 & strCents & "N" & strDollars & "X")
Else
ConvCost = (str1000 & strCents & "N" & strDollars)
End If
End Function


"JRForm" wrote:

VanS,

To help you in this you need to post the code you are using.

"VanS" wrote:

Hello,
I was testing VB code to modify the interface of VBA-programmed Excel
workbooks. Afterwards the two workbooks were shown in their folder and the
interface of one of the worksheets was displayed to the side, but when I
attempt to open either of the two books, Excel app opens but not the specific
workbooks themselves. It just shows the Excel workbook bar at top but empty
of contents. I can open the properties for either of the workbooks and it
shows the Hidden feature is unchecked.
Any idea of what happened, and/or how I can get the workbooks to display and
open?
Thanks, God bless

Thanks much for your attempts and suggestions. God bless, Van

"JRForm" wrote:

VanS,

I tried to run some of your code and it is running in the background so I
was not able to debug the problem. Try breaking your code into the specific
steps (sub routines) and then test them before putting them all together. I
would also try to start the Excel app and not close the files or protect them
as this will most likely be the last operation.

"VanS" wrote:

Thanks for your reply. Yes, I have my Excel VBA app in numerous workbooks. I
need to modify the interface of the many worksheets but I am using VB6 and I
suppose automation to open each workbook and do the modifications which
specifically are to change the contents of certain ranges I am using as
labels (4 of them on each worksheet), and change the format of an encoded
numeric value to another format. To do the latter I use the CalcCost function
to derive the numeric value of the encoded number (with an alpha character in
it) and the ConvCost to re-create the value with a new format.
Yes, I unprotect each worksheet before the work is done, then re-protect it.
The code seems to perform ok, but for some reason at some point in the
execution of the code, the workbook, although it's icon appears in its
folder, when I click on it to open it, it doesn't display anything-only an
Excel application title bar without any contents or name of the workbook. I'm
trying to take the code through debug and see where the problem begins but I
haven't been able to work continuously on it.
Any idea of what the problem may be?
Thanks, God bless
Van

"JRForm" wrote:

VanS,

I would like to help but I need a little more information and understanding.
So your application is creating an instance of Excel and then
*opening files from a specific directiory
*manipulating some named ranges
*doing some calculations
*protecting the worksheet
After all this the files are empty of data and not readable by excel?



"VanS" wrote:

Sure, see below. My original query didn't have code or get a response so I
resubmitted with below.. Thanks for your help, God bless
Option Explicit

Dim exc As EXCEl.Application

Private Sub cmdChange_Click()

strFolder = txtPath.Text
Len(txtPath.Text) - 3)
' get th search path
strPath = strFolder & "\" & "*.xls"
' get the first file with workbook extension
strFile = Dir(strPath, vbNormal)
Do While Len(strFile) < 0
'booReadOnly = False

If UCase(Left(strFile, 13)) = "EQUIPMENT VOL" Then

If GetAttr(strFolder & "\" & strFile) = vbReadOnly Then
' booReadOnly = True
SetAttr (strFolder & "\" & strFile), vbNormal
End If
'09/20/07 code below original code that worked-commented out to check
for err & added code below it

Set excBk = GetObject(strFolder & "\" & strFile, "Excel.Sheet")

For ndx = 1 To excBk.Worksheets.Count
excBk.Worksheets(ndx).Unprotect

FixLabels ndx '10/27/01
excBk.Worksheets(ndx).Protect

Next ndx 'ndx = 1 To excBk.Application.ActiveWorkbook.Worksheets.Count

excBk.Close savechanges:=True
Set excBk = Nothing '09/27/07
' check for next file
End If

strFile = Dir
Loop



End Sub


Module 1
Option Explicit
Public excBk as EXCEl.Workbook

Public Sub FixLabels(ndx As Integer)


Dim booNegative As Boolean
Dim dblCost As Double
Dim strVal As String
Dim row As Integer
Dim cell As Range


booNegative = False



excBk.Worksheets(ndx).Select
excBk.Worksheets(ndx).Activate

With excBk.Worksheets(ndx).Range("D10")
.HorizontalAlignment = xlHAlignCenter
.Value = "Standard Equipment"
.Font.Size = 10
'.Font.Bold = True
End With

With excBk.Worksheets(ndx).Range("rngReqd")
.HorizontalAlignment = xlHAlignCenter
.Value = "Must Select One from Each Box"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngDesired")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Factory Installed"
.Font.Size = 10
.Font.Bold = True
End With
With excBk.Worksheets(ndx).Range("rngField")
.HorizontalAlignment = xlHAlignCenter
.Value = "Attachments-Installed On-Site"
.Font.Size = 10
.Font.Bold = True
End With
' ChangeFormula ndx
row = excBk.Worksheets(ndx).Range("rngTerminusRw").Rows. row

For Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)
booNegative = False
If Not IsEmpty(cell.Value) Then
strVal = cell.Value
If UCase(Right(strVal, 1)) = "X" Then
booNegative = True
strVal = Left(strVal, Len(strVal) - 1)
End If
dblCost = CalcCost(strVal)
strVal = dblCost
strVal = ConvCost(strVal, booNegative)
cell.Value = strVal
End If 'Not IsEmpty(cell.Value) Then
Next 'Each cell In excBk.Worksheets(ndx).Range("L28:L" & row)






End Sub


Public Function CalcCost(strVal As String)
Dim bytLen As Byte
Dim strCents As String
Dim str1000 As String
Dim strDollars As String

strCents = Mid(strVal, 1, 2)
str1000 = Mid(strVal, 3, 1)
strDollars = Mid(strVal, 5)
CalcCost = Val(str1000 & strDollars & "." & strCents)

End Function

Public Function ConvCost(strVal As String, booNegative As Boolean)
Dim bytPeriodPos As Byte
Dim bytLen As Byte
Dim dblCost As Double
Dim strCents As String
Dim str1000 As String
Dim strDollars As String


dblCost = strVal
str1000 = Mid(dblCost, 1, 1)
' get position of decimal point
bytPeriodPos = InStr(Format(dblCost, "Fixed"), ".")
' 43,350.00 - 400N3350
'4350.50-450N350
'435.75-475N35
'43.50-450N3
'4.30- 430N

' get length of vals to go after alpha char
' if only one digit bytLen will = 0 and strDollars = ""
' so won't add to concatenation
If bytPeriodPos - 2 0 Then
bytLen = bytPeriodPos - 2
End If
strDollars = Mid(dblCost, 2, bytLen)
strCents = Right(Format(dblCost, "Fixed"), 2)
If booNegative Then
ConvCost = (str1000 & strCents & "N" & strDollars & "X")
Else
ConvCost = (str1000 & strCents & "N" & strDollars)
End If
End Function


"JRForm" wrote:

VanS,

To help you in this you need to post the code you are using.

"VanS" wrote:

Hello,
I was testing VB code to modify the interface of VBA-programmed Excel
workbooks. Afterwards the two workbooks were shown in their folder and the
interface of one of the worksheets was displayed to the side, but when I
attempt to open either of the two books, Excel app opens but not the specific
workbooks themselves. It just shows the Excel workbook bar at top but empty
of contents. I can open the properties for either of the workbooks and it
shows the Hidden feature is unchecked.
Any idea of what happened, and/or how I can get the workbooks to display and
open?
Thanks, God bless