That should work...and as you can see, I added the button to the COVER page and the module for the code you kindly provided.Quote:
Originally Posted by garak0410
That should work...and as you can see, I added the button to the COVER page and the module for the code you kindly provided.Quote:
Originally Posted by garak0410
all the Sheets are Locked that is why you cannot changed the "image".
you try this, it will unlock first the sheet then change the image and Lock it again.
i cannot test it, i am using x64 office.
It sadly still fails here...Quote:
Originally Posted by arnelgp
Attachment 30132
All the sheets look like old fashioned register cards.
If you prefer to work with Excel you should design these data as a database in only 1 sheet.
The 'Logo problem' melts away in that case.
It saves you a lot of time/trouble.
i change the name to CoLogo.
there are some "pictures" that i accidentally spoiled, please check each sheet
and compare to the original what images i accidentally replaced.
i tested and now it is changing.
just post back if anything is wrong.
I got your copy to work...I went into production copy, renamed all as CoLogo and the Macro worked...Quote:
Originally Posted by arnelgp
The only issues left is that it protected a "hidden sheet"...one called IMPORT...there may be a few other "staging" pages that are protected...
And a once functional Button/Macro now stops with this error:
Attachment 30136
When it goes to run this subroutine.
Wondering of this a protection error that doesn't specifically say it is. We are SO CLOSE...Code:Sub Export_Panel(wksName As String) Dim strWrkSheet As String
Dim sJobNum As String
Dim sCustomer As String
' Adding String for XML Conversion (BW 20200124)
Dim sName As String
Dim sOut As String
Dim sXtra As String
Dim fh As Long
Dim i As Integer, iu As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim intRowLast As Integer
Dim wkSheet As Worksheet
Dim blnVisible As Boolean
Dim lQty As Long
Dim lRC_Qty As Long
Dim dLength As Double
Dim sProfile As String
Dim dWeight As Double
Set colSheetNames = New Collection
Workbooks(wksName).Activate
strWrkSheet = ActiveSheet.Name
'JobNumber,CustomerName,LineID,RequestedQty,CoilPartNum,LENGTH,Profile,Color,PieceMark,Description,BundleMark,Weight
For Each wkSheet In ActiveWorkbook.Worksheets
If Left(wkSheet.Name, 8) = "PINN PAN" Then
colSheetNames.Add (wkSheet.Name)
End If
Next wkSheet
If ConfirmWeights("Panel") = False Then Exit Sub
' PrepareImportPage4Panel (wksName)
'****************************************************
'Stop 'For Debugging Prep code! Rem when not in use.*
'****************************************************
fh = FreeFile
Sheets("PINN PANEL").Select
sJobNum = Cells(2, 5).Value
If Val(Left$(sJobNum, 1)) = 0 Then
sJobNum = Format$(Now(), "yy") & sJobNum
ElseIf Left$(sJobNum, 1) > 6 Then
sJobNum = "0" & sJobNum
End If
If InStr(sJobNum, ",") <> 0 Then sJobNum = Replace(sJobNum, ",", "")
' Open "\\BR_Panel\Panel$\" & sJobNum & "-Panel.csv" For Output As #fh <--- ORIGINAL Line
' Open "C:\" & sJobNum & "-Panel.csv" For Output As #fh
Open "\\fileserver\Bradbury-Xfer\Panel\" & sJobNum & "-Panel.csv" For Output As #fh
' variable for XML conversion (BW 20200124)
sName = "\\fileserver\Bradbury-Xfer\Panel\" & sJobNum & "-Panel"
sOut = "JobNumber,CustomerName,LineID,RequestedQty,CoilPartNum,Length,Profile,Color,PieceMark,Description,BundleMark,Weight"
Print #fh, sOut ' Header
sCustomer = Replace(Cells(3, 5).Value, ",", "")
sOut = sJobNum & "," & sCustomer
l = 1
For i = 1 To colSheetNames.Count
If blnVisible = True Then blnVisible = False
If Sheets(colSheetNames(i)).Visible = False Then
Sheets(colSheetNames(i)).Visible = True
blnVisible = True
End If
Sheets(colSheetNames(i)).Select
ActiveSheet.Range("A65536").End(xlUp).Select
intRowLast = Int(Right(ActiveCell.Address, Len(ActiveCell.Address) - 3))
For j = 12 To intRowLast
If Val(Cells(j, 1).Value) <> 0 _
And InStr(UCase(Cells(j, 4).Value), "LITE") = 0 _
And InStr(UCase(Cells(j, 4).Value), "SKY") = 0 Then
lQty = Cells(j, 1).Value
sProfile = Mid$(Cells(j, 4).Value, 4)
dLength = CInches(Cells(j, 6).Value) / 12 ' Length in feet (decimal)
sOut = sOut & ",Panel" ' LineID
If sProfile = "RC" Then
lRC_Qty = -1 * Int(-1 * lQty * dLength / 10) ' Quantity of 10' sheets
sOut = sOut & ("," & CStr(lRC_Qty)) ' Quantity (4 RCs per sheet)
sOut = sOut & ",00.000X00G" ' CoilPartNumber (bogus for Panel)
sOut = sOut & ",120" ' Length in inches (decimal)
dWeight = lRC_Qty * 28.2 ' 2'-6" RC weighs 7.05 pounds
Else
sOut = sOut & ("," & Cells(j, 1).Value) ' Part quantity
sOut = sOut & ",00.000X00G" ' CoilPartNumber (bogus for Panel)
sOut = sOut & ("," & CInches(Cells(j, 6).Value)) ' Length in inches (decimal)
End If
sOut = sOut & ("," & Trim$(Cells(j, 4).Value)) ' Profile
sOut = sOut & ("," & Left$(Cells(j, 5).Value, 15)) ' Color
'We are having a problem with the Piece Marks and the CTC. The following code
'is simply to work around the issue.
If InStr(UCase(Cells(j, 2).Value), "XTRA") > 0 Then
k = InStr(UCase(Cells(j, 2).Value), "XTRA")
'I do not expect to see 10 or more extra parts, but if it happens we are ready.
Do Until k = 0
If Asc(Mid(UCase(Cells(j, 2).Value), k, 1)) > 47 And _
Asc(Mid(UCase(Cells(j, 2).Value), k, 1)) < 58 Then
sXtra = Mid(UCase(Cells(j, 2).Value), k, 1) & sXtra
End If
k = k - 1
Loop
sOut = sOut & ("," & sXtra & "Xtra") ' Piece mark (modified)
Else
sOut = sOut & ("," & Left$(Cells(j, 2).Value, 25)) ' Piece mark
End If
sOut = sOut & ("," & Left$(Cells(j, 3).Value, 25)) ' Description
sOut = sOut & (",Bundle1") ' Bundle mark
If sProfile = "RC" Then
sOut = sOut & ("," & Format$(dWeight, "#.0###")) ' RC Weight (total)
Else
sOut = sOut & ("," & Format$(Cells(j, 7).Value, "#.0###")) ' Weight (total)
End If
l = l + 1
Print #fh, sOut
sOut = ","
End If
Next j
If blnVisible = True Then Sheets(colSheetNames(i)).Visible = False
Next i
Sheets(strWrkSheet).Select
Range("K10").Select
If Range("K10").Value = "" Then
With Selection
.HorizontalAlignment = xlRight
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Value = "Released"
End With
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
With Selection
.HorizontalAlignment = xlRight
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Value = "Again"
End With
With Selection.Interior
.ColorIndex = 50
.Pattern = xlSolid
End With
End If
Close #fh
' command to convert CSV to XML (BW 20200124)
Shell """C:\ShipperXML\Panel\CsvToXml.exe"" """ & sName & ".csv"" """ & sName & ".xml""", vbNormalFocus
' New XML Conversion
' Shell "C:\Program Files\CSVtoXML\CsvToXml.exe """ & inputFile & """ """ & outputFile, vbNormalFocus
' orginal attempt at converting to xml
' Dim bSaved As Boolean
' bSaved = CSV2XML("\\fileserver\Bradbury-Xfer\Panel\Test", "test.csv", "ConvertedCSV.xml")
' Application.ScreenUpdating = True
' Application.ScreenUpdating = True
' Set colSheetNames = Nothing
End Sub
If I am right, should I add a statement to say if sheet is hidden or not yet created, to change to UNPROTECTED? When this sheet does it's other subroutines and such, it does create staging pages for the data and that's where I am running into the issues now. If I need to post the project back, I can.Quote:
Originally Posted by garak0410
Update - I've mostly fixed it by putting in a few more unprotect commands. Going to test it in production in the morning. Will update then.
Thank you for all of the help...
I do have one more question...
How do I set the PATH for the File Picker?
It needs to go to \\fileserver\drafting\logos
Thanks!
I wanted to update everyone...the logo changing is working great...and thank you for all of your help.
Because I needed the sheet to be unprotected on several occasions, I am currently trying to track down the one unprotect I don't need...and it isn't even related to the change logo code.