Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem: Workbook contents vanish
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem: Workbook contents vanish
When you open the workbook select Window frm the Menu Bar then you can Unhide
the workbook. Not sure what causes this, maybe because you are using GetObject? You have a variable for the Excel application but it is not used. I changed the code and used the Excel application and it works. I ran the code in Access so the strFolder reference would be incorrect for your app. Option Explicit Dim exc As New Excel.Application Dim excBk As Excel.Workbook Public Sub cmdChange_Click() strFolder = CurrentProject.Path ' 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 = exc.Workbooks.Open(strFolder & "\" & strFile) 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 exc.Quit Set exc = Nothing End Sub "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. 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem: Workbook contents vanish
Thanks, Ralph, I'll try it out. Much appreciate your response, God bless,
Van "Ralph" wrote: When you open the workbook select Window frm the Menu Bar then you can Unhide the workbook. Not sure what causes this, maybe because you are using GetObject? You have a variable for the Excel application but it is not used. I changed the code and used the Excel application and it works. I ran the code in Access so the strFolder reference would be incorrect for your app. Option Explicit Dim exc As New Excel.Application Dim excBk As Excel.Workbook Public Sub cmdChange_Click() strFolder = CurrentProject.Path ' 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 = exc.Workbooks.Open(strFolder & "\" & strFile) 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 exc.Quit Set exc = Nothing End Sub "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. 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
VLOOKUP - Hyperlinks Vanish | Excel Worksheet Functions | |||
Workbook contents vanish | Excel Programming | |||
Excel cells vanish. | Excel Discussion (Misc queries) | |||
VBA & User Form modules vanish | Excel Programming | |||
Hyperlink Vanish after if been Copy???? | Excel Programming |