Sub auswahl_auslesen
	Dim pm as Object
	Set pm = CreateObject("PlanMaker.Application")
	pm.Application.Visible = True

	Dim AuswahlBereich as Object
	Dim row, col, antw, awcol, awrow, tabNum, zielTab, i as Integer
	Dim swert
	Dim AktTab as String
	Dim farbe as long
	Set AuswahlBereich = pm.ActiveSheet.Selection
	AktTab = pm.ActiveSheet.Name
	Dim Tabels(1 to 10) as String
	tabNum = pm.ActiveWorkbook.Sheets.Count
	If tabNum > 10 Then
		tabNum= 10
	End If

	For i = 1 to tabNum
		Tabels(i) = pm.ActiveWorkbook.Sheets(i).Name
	Next

Begin Dialog DLGAUS 147,54, 150, 190, "Ausgewählte Zellen übertragen"
  DropListBox 16,10,72,40, Tabels(),.DrpList
  Text 90,12,60,12, "Tabelle als Ziel wählen"
  GroupBox 16,28,90,50, "Startposition"
  TextBox 60,40,28,12, .idZ
  TextBox 60,60,28,12, .idS
  Text 24,40,24,12, "Zeile"
  Text 24,60,20,12, "Spalte"
  GroupBox 16,90,90,36, "Ausrichtung"
  OptionGroup .grp1
	  OptionButton 24, 100, 48, 12, "eine Zeile"
     OptionButton 24, 110, 48, 12, "eine Spalte"
  OKButton 16,136,56,32
  CancelButton 88,136,52,32
End Dialog

Dim Dlg1 as DLGAUS
antw = Dialog(DLGAUS)
If antw = -1 Then
	MsgBox Dlg1.grp1
	zielTab =  1 + Dlg1.DrpList
	awcol = Dlg1.idS
	awrow = Dlg1.idZ
	For row = 1 To AuswahlBereich.Rows.Count
		For col = 1 to AuswahlBereich.Columns.Count
     		swert = AuswahlBereich.Cells.Item(row, col).Value
			farbe = AuswahlBereich.Cells.Item(row, col).Font.BColor
			If  farbe <> -1 then
				pm.ActiveWorkbook.Sheets(zielTab).Rows(awrow).Columns(awcol).Value = swert
				If Dlg1.grp1 = 0 Then
					awcol = awcol + 1
				Else
					awrow = awrow + 1
				End If
			End If 		
  		Next col
	Next row
   antw = MsgBox("Alle Zellen wieder Transparent machen?", MB_YESNO + MB_ICONQUESTION, "Zellen auslesen")
   If antw = IDYES Then
		pm.ActiveSheet.Selection.Font.BColor = -1
	End If
End If
 	Set pm = Nothing
End Sub