V
VanS
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.
The TaskManager only shows the Excel process but not the Workbook I tried to
open in the Applications window, but under the File Menu it shows the
Workbook present.
Any idea of what happened, and/or how I can get the workbooks to display and
open? (code below)
Thanks, 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
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.
The TaskManager only shows the Excel process but not the Workbook I tried to
open in the Applications window, but under the File Menu it shows the
Workbook present.
Any idea of what happened, and/or how I can get the workbooks to display and
open? (code below)
Thanks, 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