UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Comments to values    
 
   
vajra918
post Mar 25 2004, 05:44 PM
Post#1



Posts: 5
Joined: 18-March 04



So, I was converting a excel sheet to a access db, easy right... except the prior user stored mountans of info in comments on paticular cells. when you import all comments are lost, so I had to write a bit of creative code, and it works great. I hope this saves sombody from the same grief i felt.
aron
CODE
Option Explicit
Public Sub stripComments()
Dim _
sht As Object, s As Object, _
cmt As Object, i As Integer, _
c   As Object
    Dim myComment As String
    Dim mySheet As Object
    Set sht = Sheets
    Application.DisplayAlerts = False
    For Each s In sht
        If s.Name = "Comments" Then s.Delete
    Next
    Application.DisplayAlerts = True
    Set mySheet = Sheets.Add(Type:=xlWorksheet, after:=Worksheets(Worksheets.Count))
    mySheet.Name = "Comments"
    Set cmt = Worksheets(1).Comments
    i = 1
    For Each c In cmt
        myComment = c.Text
        myComment = Worksheets(1).Range(Mid(c.Parent.Address, 1, 2) & "$1").Value & ":  " & delTag(myComment)
        Debug.Print Range("$A" & Mid(c.Parent.Address, 3, 5)).Value
        mySheet.Range("a" & i).Value = Worksheets(1).Range("$A" & Mid(c.Parent.Address, 3, 5)).Value
        mySheet.Range("b" & i).Value = myComment
        i = i + 1
    Next
    Call format(mySheet)
End Sub
Private Function delTag(strData As String)
    Dim _
    l   As Long, s As Integer, rtn As String, _
    del As String
    del = vbLf
    l = Len(strData)
    s = 1
    While l > 0
        If Mid(strData, s, 1) = del Then
            GoTo Finish
        Else
            rtn = rtn & Mid(strData, s, 1)
        End If
        s = s + 1
        l = l - 1
    Wend
Finish:
    delTag = Right(strData, Len(strData) - (Len(rtn) + 1))
End Function
Private Sub format(mySheet As Object)
        With mySheet.Cells
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .ShrinkToFit = False
            .MergeCells = False
        End With
        With mySheet.Columns("A:A")
            .EntireColumn.AutoFit
            .NumberFormat = "0000000000"
        End With
End Sub
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    18th December 2017 - 05:14 PM