Visual Basic

djdrew wrote:

Append values to RTF string
_rtf.Append("{\pict\wmetafile8")
_rtf.Append("\picw")
_rtf.Append(picw)
_rtf.Append("\pich")
_rtf.Append(pich)
_rtf.Append("\picwgoal")
_rtf.Append(picwgoal)
_rtf.Append("\pichgoal")
_rtf.Append(picw)
_rtf.Append(" ")

_rtf.Append("{\pict\wmetafile8")
_rtf.Append("\picw")
_rtf.Append(picw)
_rtf.Append("\pich")
_rtf.Append(pich)
_rtf.Append("\picwgoal")
_rtf.Append(picwgoal)
_rtf.Append("\pichgoal")

// here is the typo, where you had picw
_rtf.Append(pichgoal)
_rtf.Append(" ")

Public Class Form12 Inherits System.Windows.Forms.Form
#Region " Windows Form Designer generated code "

#End Region

Private Sub TreeView1_AfterSelect(ByVal sender As System.Object, ByVal e As_
System.Windows.Forms.TreeViewEventArgs) Handles TreeView1.AfterSelect
Label1.Text = "You are here->" & " " & e.Node.FullPath
'displaying the path of the selected node
Label2.Text = "Current node selected:" & " " & e.Node.Text
'displaying the selected node
End Sub

End Class 

Private Sub treeQiaoTi_NodeMouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.TreeNodeMouseClickEventArgs) Handles treeQiaoTi.NodeMouseClick
        Me.Text = e.Node.Text ' real text in clicked node.
        If e.Node.Text = "abc" Then 'Check this abc
            panJieGuan2.Visible = False
            Panel1.Visible = True
            Panel1.BringToFront() 'Check it
        Else
            Panel1.Visible = False
            panJieGuan2.Visible = True
            panJieGuan2.BringToFront() 'It too
        End If
    End Sub

Private Sub treeQiaoTi_AfterSelect(ByVal sender As System.Object, ByVal e As System.Windows.Forms.TreeViewEventArgs) Handles treeQiaoTi.AfterSelect
End Sub

Dim i As Integer
 i = 1        

   While Trim(sheet2.Cells(i, 1)) <> ""
      sheet1.cells(i,1)=sheet2.cells(i,1)
      sheet1.cells(i,2)=sheet2.cells(i,2)
      sheet1.cells(i,3)=sheet2.cells(i,3)
      i=i+1
   wend

Dim i As Integer
 i = 1        

   While Trim(sheet2.Cells(i, 1)) <> ""
      sheet1.cells(i+1,1)=sheet2.cells(i,1)
      sheet1.cells(i+1,2)=sheet2.cells(i,2)
      sheet1.cells(i+1,3)=sheet2.cells(i,3)
      i=i+1
   wend

i=2

if sheet1.cells(1,1)=sheet2.cells(1,1) then

Dim i As Integer
 i = 2         
 While Trim(sheet2.Cells(i, 1)) <> ""
   sheet1.cells(i,1)=sheet2.cells(i,1)
   sheet1.cells(i,2)=sheet2.cells(i,2) 
   sheet1.cells(i,3)=sheet2.cells(i,3)  
   i=i+1   
 wend
End if

Sub CopyToTarget()
    Dim tgt As Excel.Workbook
    Dim target As String
    Dim rng As Range
    
    ' define the range to copy here
    ' with End(xlDown) you catch all the rows as long as there are no empty cells.
    Set rng = ActiveSheet.Range(Cells(2, 1), Cells(2, 1).End(xlDown))
    
    ' open the target workbook as object; in this case the workbook has to exist already!
    Set tgt = Application.Workbooks.Open("D:\Target.xls")
    
    ' copy the range to the required cell
    rng.Copy tgt.Worksheets("Tabelle1").Cells(2, 1)
    
    ' save and close the target workbook
    tgt.Save
    tgt.Close
    
    ' delete objects that are no longer needed
    Set rng = Nothing
    Set tgt = Nothing
End Sub

if ActiveSheet.Range(Cells(1, 1)="Emp Num" then
  Set rng = ActiveSheet.Range(Cells(2, 1), Cells(2, 1).End(xlDown))
   Set tgt = Application.Workbooks.Open("D:\Target.xls")
   rng.Copy tgt.Worksheets("Tabelle1").Cells '  tgt.Save
   tgt.Close
end if

Sub CopyToTarget()
    Dim tgt As Excel.Workbook
    Dim rng As Range
    Dim srcHeader As Range
    Dim tgtHeader As Range
    Dim dataCol As Integer
    
    ' define the range to copy here, supplying the column no you wish to copy
    ' with End(xlDown) you catch all the rows as long as there are no empty cells.
    dataCol = 1
    Set srcHeader = ActiveSheet.Cells(1, dataCol)
    Set rng = srcHeader.Range(Cells(2, dataCol), Cells(2, dataCol).End(xlDown))
    
    ' open the target workbook as object; in this case the workbook has to exist already!
    Set tgt = Application.Workbooks.Open("D:\Target.xls")
    
    ' find the header of the given dataCol in row 1 of the target worksheet
    Set tgtHeader = tgt.Worksheets("Table1").Rows(1).EntireRow.Find(srcHeader.Value)
    
    ' copy the range to the required cell
    ' if not found then notice the user
    If tgtHeader Is Nothing Then
        MsgBox "Header not found in target workbook."
    Else
        rng.Copy tgt.Worksheets("Table1").Cells(2, tgtHeader.Column)
    End If
    
    ' save and close the target workbook
    tgt.Save
    tgt.Close
    
    ' delete objects that are no longer needed
    Set rng = Nothing
    Set srcHeader = Nothing
    Set tgtHeader = Nothing
    Set tgt = Nothing
End Sub

Sub ReArrange()
    Dim strHeaders() As String
    Dim sortOrder As String
    Dim i As Integer
           
    ' define how the columns / headers are to be arranged
    sortOrder = "EmpID,EmpName,EmpSalary"
    ' read the string into an array
    strHeaders = Split(sortOrder, ",")
    
    ' loop through the array
    For i = LBound(strHeaders) To UBound(strHeaders)
        ' take care: i will be 0 first (array index starting with 0)
        ' so you can't assign i to a colunm --> i + 1 is fine
        MsgBox "Header of column " & i + 1 & " = " & strHeaders(i)
        ' here you find the respective header and copy your headers and/or data.
        ' I guess you can adapt the code sample from before already, can you?
    Next
End Sub